home *** CD-ROM | disk | FTP | other *** search
- : To unbundle, sh this file
- echo unbundling disclaim 1>&2
- cat >disclaim <<'End'
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- End
- echo unbundling Makefile 1>&2
- cat >Makefile <<'End'
- CFLAGS =
- LFLAGS =
- LIB = -lm
-
- BINDIR = ../bin
- PARSEDIR = ../parser
-
- Objects = main.o object.o line.o \
- class.o number.o symbol.o string.o byte.o array.o file.o \
- primitive.o syms.o cldict.o process.o interp.o block.o courier.o \
- lex.o drive.o lexcmd.o
- Objects.c = main.c object.c line.c \
- class.c number.c symbol.c string.c byte.c array.c file.c \
- primitive.c syms.c cldict.c process.c interp.c block.c courier.c \
- lex.c drive.c lexcmd.c
- MISC = disclaim Makefile *.h sstr.c symbols newmal.c
-
- st: sstr drive.h cmds.h env.h $(Objects)
- cc $(LFLAGS) -o st $(Objects) $(LIB)
-
- newst: sstr drive.h cmds.h env.h $(Objects)
- cc $(LFLAGS) -o newst $(Objects) $(LIB)
-
- # the following is used by st make script for installation on the DecPro 350
- # ld -o st -X -u __doprnt -u fltused -u fptrap -m \
- # -lfpsim /lib/fcrt0.o $(Objects) -lm -lc
-
- install: st
- mv st $(BINDIR)
-
- bundle: $(MISC) $(Objects.c)
- rm -f drive.h cmds.h env.h
- bundle $(MISC) $(Objects.c) >../sources.bundle
-
- lint.out:$(Objects.c)
- lint $(Objects.c)
-
- syms.c: sstr symbols
- sstr -t symbols SYMTABMAX '# include "object.h"' '# include "symbol.h"' >syms.c
-
- sstr: sstr.c
- cc $(LFLAGS) -o sstr sstr.c
-
- drive.h: $(PARSEDIR)/drive.h symbols
- cp $(PARSEDIR)/drive.h .
-
- cmds.h: $(PARSEDIR)/cmds.h symbols
- sstr symbols <$(PARSEDIR)/cmds.h >cmds.h
-
- env.h: $(PARSEDIR)/env.h
- cp $(PARSEDIR)/env.h .
-
- number.o: number.c number.h
- interp.o: drive.h cmds.h
- primitive.o: *.h
- main.o: *.h
-
- clean:
- -rm *.o drive.h cmds.h env.h
- End
- echo unbundling block.h 1>&2
- cat >block.h <<'End'
- /*
- Little Smalltalk
-
- block definitions
- timothy a. budd, 10/84
- */
- /*
- for blocks
-
- b_size = BLOCKSIZE
-
- b_interpreter is an instance of interpreter that will
- actually execute the bytecodes for the block.
-
- b_numargs and b_arglocation are the number of arguments and
- the starting argument location in the context array.
-
- */
-
- struct block_struct {
- int b_ref_count;
- int b_size;
- interpreter *b_interpreter;
- int b_numargs;
- int b_arglocation;
- } ;
-
- typedef struct block_struct block;
-
- extern object *new_block();
- extern interpreter *block_execute();
- End
- echo unbundling byte.h 1>&2
- cat >byte.h <<'End'
- /*
- Little Smalltalk
- Bytearray definitions
- */
-
- struct byte_struct {
- int a_ref_count;
- int a_size;
- int a_bsize;
- uchar *a_bytes;
- } ;
-
- typedef struct byte_struct bytearray;
-
- # define byte_value(x) (((bytearray *)(x))->a_bytes)
-
- /*
- bytearrays of size less than MAXBSAVE are kept on a free list
- */
- # define MAXBSAVE 50
-
- /*
- in order to avoid a large number of small mallocs, especially
- while reading the standard prelude, a fixed area of MAXBTABSIZE is
- allocated and used for bytecodes until it is full. Thereafter
- bytecodes are allocated using malloc. This area should be large
- enough to hold at least all the bytecodes for the standard prelude.
- */
- # define MAXBTABSIZE 5500
-
- /*
- for the same reason, a number of bytearrays structs are statically
- allocated and placed on a free list
- */
- # define MAXBYINIT 400
-
- extern object *new_bytearray();
- End
- echo unbundling file.h 1>&2
- cat >file.h <<'End'
- /*
- Little Smalltalk
-
- class File definitions
- timothy a. budd, 11/84
- */
- /*
- files use standard i/o package
- */
-
- struct file_struct {
- int l_ref_count;
- int l_size;
- int file_mode;
- FILE *fp;
- };
-
- typedef struct file_struct file;
-
- extern object *new_file();
- extern object *file_read();
-
- /* files can be opened in one of three modes, modes are either
- 0 - char mode - each read gets one char
- 1 - string mode - each read gets a string
- 2 - integer mode - each read gets an integer
- */
- # define CHARMODE 0
- # define STRMODE 1
- # define INTMODE 2
- End
- echo unbundling interp.h 1>&2
- cat >interp.h <<'End'
- /*
- Little Smalltalk interpeter definitions
- */
- /*
- for interpreters
- t_size = INTERPSIZE
-
- creator is a pointer to the interpreter which created
- the current interpreter. it is zero except in the case
- of blocks, in which case it points to the creating
- interpreter for a block. it is NOT a reference, ie,
- the ref_count field of the creator is not incremented when
- this field is set - this avoids memory reference loops.
-
- stacktop is a pointer to a pointer to an object, however it
- is not considered a reference. ie, changing stacktop does
- not alter reference counts.
- */
-
- struct interp_struct {
- int t_ref_count;
- int t_size; /* should always be INTERPSIZE */
- struct interp_struct *creator;
- struct interp_struct *sender;
- object *bytecodes;
- object *receiver;
- object *literals;
- object *context;
- object *stack;
- object **stacktop;
- uchar *currentbyte;
- };
-
- typedef struct interp_struct interpreter;
-
- extern interpreter *cr_interpreter();
-
- extern object *o_drive;
-
- # define is_driver(x) (o_drive == (object *) x)
- End
- echo unbundling number.h 1>&2
- cat >number.h <<'End'
- /*
- Little Smalltalk number definitions
-
- */
- /*
- integer and character definitions
- for integers
- i_size = INTEGERSIZE
-
- for characters
- i_size = CHARSIZE
-
- */
-
- struct int_struct {
- int i_ref_count;
- int i_size;
- int i_value;
- };
-
- typedef struct int_struct integer;
-
- # define int_value(x) (((integer *)x)->i_value)
- # define char_value(x) ((char) int_value(x))
-
- extern object *new_cori(); /* new Character OR Integer */
-
- # define new_int(x) new_cori(x, 1)
- # define new_char(x) new_cori(x, 0)
-
- # define INTINITMAX 50
-
- /*
- floating point definitions
- size should always be FLOATSIZE
- */
-
- struct float_struct {
- int f_ref_count;
- int f_size;
- double f_value;
- };
-
- typedef struct float_struct sfloat;
-
- # define float_value(x) (((sfloat *)x)->f_value)
-
- extern object *new_float();
- End
- echo unbundling object.h 1>&2
- cat >object.h <<'End'
- /*
- Little Smalltalk object definitions
- */
- # include "env.h"
- /*
- for objects the inst_var array is actually made as large as
- necessary (as large as the size field). since C does not do
- subscript bounds checking array indexing can be used
- */
-
- struct obj_struct {
- int ref_count;
- int size;
- struct class_struct *class;
- struct obj_struct *super_obj;
- struct obj_struct *inst_var[1];
- };
-
- /*
- for classes
- c_size = CLASSSIZE
-
- class_name and super_class should be SYMBOLs
- containing the names of the class and superclass,
- respectively.
-
- c_inst_vars should be an array of symbols, containing the
- names of the instance variables
-
- context size is the size of the context that should be
- created each time a message is sent to objects of this
- class.
-
- message_names should be an array of symbols, corresponding
- to the messages accepted by objects of this class.
-
- methods should be an array of arrays, each element being a
- two element array of bytecodes and literals.
- */
-
- struct class_struct {
- int c_ref_count;
- int c_size;
- struct obj_struct *class_name;
- struct obj_struct *super_class;
- struct obj_struct *file_name;
- struct obj_struct *c_inst_vars;
- int context_size;
- struct obj_struct *message_names;
- struct obj_struct *methods;
- int stack_max;
- };
-
- typedef struct class_struct class;
- typedef struct obj_struct object;
-
- /*
- objects with non-object value (classes, integers, etc) have a
- negative size field, the particular value being used to indicate
- the type of object (the class field cannot be used for this purpose
- since all classes, even those for built in objects, can be redefined)
-
- check_bltin is a macro that tests the size field for a particular
- value. it is used to define other macros, such as is_class, that
- test each particular type of object.
-
- The following classes are builtin
-
- Block
- ByteArray
- Char
- Class
- Float
- Integer
- Interpreter
- String
- Symbol
- */
-
- # define BLOCKSIZE -83
- # define BYTEARRAYSIZE -567
- # define CHARSIZE -33
- # define CLASSSIZE -3
- # define FILESIZE -5
- # define FLOATSIZE -31415
- # define INTEGERSIZE -17
- # define INTERPSIZE -15
- # define PROCSIZE -100
- # define STRINGSIZE -258
- # define SYMBOLSIZE -14
-
- # define is_bltin(x) (x && (((object *) x)->size < 0))
- # define check_bltin(obj, type) (obj && (((object *) obj)->size == type))
-
- # define is_block(x) check_bltin(x, BLOCKSIZE)
- # define is_bytearray(x) check_bltin(x, BYTEARRAYSIZE)
- # define is_character(x) check_bltin(x, CHARSIZE)
- # define is_class(x) check_bltin(x, CLASSSIZE)
- # define is_file(x) check_bltin(x, FILESIZE)
- # define is_float(x) check_bltin(x, FLOATSIZE)
- # define is_integer(x) check_bltin(x, INTEGERSIZE)
- # define is_interpreter(x) check_bltin(x, INTERPSIZE)
- # define is_process(p) check_bltin(p, PROCSIZE)
- # define is_string(x) check_bltin(x, STRINGSIZE)
- # define is_symbol(x) check_bltin(x, SYMBOLSIZE)
-
- /*
- mstruct is used (via casts) to store linked lists of structures of
- various types for memory saving and recovering
- */
-
- struct mem_struct {
- struct mem_struct *mlink;
- };
-
- typedef struct mem_struct mstruct;
-
- /*
- sassign assigns val to obj, which should not have a valid
- value in it already.
- assign decrements an existing val field first, then assigns.
- note this will not work for assign(x,x) if x ref count is 1.
- safeassign, although producing less efficient code, will work even
- in this case
- */
- # define sassign(obj, val) obj_inc((object *) (obj = val))
- # define assign(obj, val) {obj_dec((object *) obj); sassign(obj, val);}
- # define safeassign(obj, val) {obj_inc((object *) val); \
- obj_dec((object *) obj); obj = val; }
-
- /* structalloc calls alloc to allocate a block of memory
- for a structure and casts the returned
- pointer to the appropriate type */
- # define structalloc(type) (type *) o_alloc(sizeof(type))
-
- /*
- if INLINE is defined ( see env.h ) , inline code will be generated
- for object increments. inline code is generally faster, but
- larger than using subroutine calls for incs and decs
- */
-
- extern int n_incs, n_decs;
-
- # ifdef INLINE
-
- # define obj_inc(x) n_incs++, (x)->ref_count++
- extern object *_dx;
- # define obj_dec(x) {n_decs++; if (--((_dx=x)->ref_count) <= 0) ob_dec(_dx);}
-
- # endif
-
- extern char *o_alloc(); /* allocate a block of memory */
- extern object *new_inst(); /* make a new instance of a class */
- extern object *new_sinst(); /* an internal (system) version of new_inst*/
- extern object *new_obj(); /* allocate a new object */
- extern object *new_array(); /* make a new array */
- extern object *primitive(); /* perform a primitive operation */
-
- extern object *o_nil; /* current value of pseudo variable nil */
- extern object *o_true; /* current value of pseudo variable true */
- extern object *o_false; /* current value of pseudo variable false */
- extern object *o_smalltalk; /* current value of pseudo var smalltalk */
-
- extern int debug; /* debugging toggle */
-
- /* reference count macro, used during debugging */
- # define rc(x) ((object *)x)->ref_count
- End
- echo unbundling primitive.h 1>&2
- cat >primitive.h <<'End'
- /*
- Little Smalltalk primitive definitions
-
- (only a subset of primitives are described here,
- basically those used by the courier and other systems routines.
- All other primitives are known only by number)
-
- */
- # define EQTEST 7
- # define GAMMAFUN 77
- # define SYMEQTEST 91
- # define SYMPRINT 94
- # define FINDCLASS 99
- # define GROW 113
- # define BLKRETERROR 127
- # define REFCOUNTERROR 128
- # define NORESPONDERROR 129
- # define RAWPRINT 120
- # define PRINT 121
- # define ERRPRINT 123
- # define BLOCKEXECUTE 140
- # define DOPERFORM 143
- End
- echo unbundling process.h 1>&2
- cat >process.h <<'End'
- /*
- Little Smalltalk
-
- process definitions
- dennis a. vadner and michael t. benhase, 11/84
- */
- /*
- the process
-
- interp = pointer to the head of the process'
- interpreter chain
- p_state = current state of the process
-
- next = link to the next process in the active list
- prev = link to the previous process in the active list
- */
-
-
- struct process_struct {
- int p_ref_count;
- int p_size;
- interpreter *interp;
- int p_state;
- struct process_struct *next;
- struct process_struct *prev;
- } ;
-
- typedef struct process_struct process;
-
- extern int atomcnt; /* atomic action flag */
- extern process *runningProcess; /* currently running process */
-
- extern process *cr_process(); /* create a new process */
- extern int set_state(); /* set the state on a process */
-
-
- /* process states */
-
- # define ACTIVE 0
- # define SUSPENDED 1
- # define READY ~SUSPENDED
- # define BLOCKED 2
- # define UNBLOCKED ~BLOCKED
- # define TERMINATED 4
-
- # define CUR_STATE 10
-
-
- # define terminate_process(aProcess) {set_state(aProcess, TERMINATED); \
- if (aProcess == runningProcess) \
- atomcnt = 0;}
- End
- echo unbundling string.h 1>&2
- cat >string.h <<'End'
- /*
- Little Smalltalk string definitions
- */
- /*
- for strings s_size = STRINGSIZE
-
- Unlike other special objects (integers, floats, etc), strings
- must keep their own super_obj pointer, since the class
- ArrayedCollection (a super class of String) contains instance
- variables, and thus each instance of String must have a unique
- super_obj.
- */
-
- struct string_struct {
- int s_ref_count;
- int s_size;
- object *s_super_obj;
- char *s_value;
- } ;
-
- typedef struct string_struct string;
-
- extern object *new_str(); /* make a new string object */
- extern string *new_istr(); /* internal form of new string */
- extern char *walloc(); /* allocate a copy a word */
-
- # define string_value(x) (((string *) x)->s_value)
- End
- echo unbundling symbol.h 1>&2
- cat >symbol.h <<'End'
- /*
- Little Smalltalk string and symbol definitions
- */
- /*
- for symbols y_size = SYMBOLSIZE
-
- only one text copy of each symbol is kept.
- A global symbol table is searched each time a new symbol is
- created, and symbols with the same character representation are
- given the same entry.
-
- */
-
- struct symbol_struct {
- int y_ref_count;
- int y_size;
- char *y_value;
- } ;
-
- typedef struct symbol_struct symbol;
-
- extern symbol *sy_search(); /* binary search for a symbol */
- extern char *w_search(); /* binary search for a word */
-
- # define symbol_value(x) (((symbol *) x)->y_value)
- # define new_sym(val) ((object *) sy_search(val, 1))
-
-
- # define SYMTABMAX 500
-
- /* SYMINITSIZE symbol entries are allocated at the start of execution,
- which prevents malloc from being called too many times */
-
- # define SYMINITSIZE 60
- End
- echo unbundling sstr.c 1>&2
- cat >sstr.c <<'End'
- /*
- sstr - find and replace string occurrences
- with common addresses,
- can be used to share strings accross compiled boundaries
- written by tim budd, 9/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # define WORDTABMAX 1000
- # define STRTABMAX 10000
-
- int x_cmax = 0;
- int x_tmax = -1;
- char x_str[STRTABMAX];
- char *x_tab[WORDTABMAX];
-
-
- main(argc, argv)
- int argc;
- char **argv;
- { int i;
- FILE *fd;
-
- if (strcmp(argv[1], "-f") == 0) {
- for (i = 2; i < argc; i++) {
- fd = fopen(argv[i], "r");
- if (fd != NULL) {
- findstrs(fd);
- fclose(fd);
- }
- }
- }
- else if (strcmp(argv[1], "-t") == 0) {
- for (i = 4; i < argc; i++)
- puts(argv[i]);
- fd = fopen(argv[2], "r");
- if (fd == NULL) {
- fprintf(stderr,"can't open string table\n");
- exit(1);
- }
- maketab(fd, stdout, argv[3]);
- }
- else {
- fd = fopen(argv[1], "r");
- if (fd == NULL) {
- fprintf(stderr,"can't open string table\n");
- exit(1);
- }
- maketab(fd, 0, 0);
- printf("extern char x_str[];\n");
- replacestr(stdin);
- }
- exit(0);
- }
-
- /* findstrs - find all strings and output them to stdout */
- findstrs(fd)
- FILE *fd;
- {
- char *p, buffer[500];
- int c;
-
- for (; (c = getc(fd)) != EOF; )
- if (c == '\"') {
- for (p = buffer; (c = getc(fd)) != '\"'; p++)
- if (c == EOF) {
- fprintf(stderr,"unexpected eof\n");
- exit(1);
- }
- else *p = c;
- *p = '\0';
- puts(buffer);
- }
- }
-
- /* replacestr - replace strings with their address in x_str */
- replacestr(fd)
- FILE *fd;
- {
- char *p, buffer[500], *w_search();
- int c;
-
- for (; (c = getc(fd)) != EOF; )
- if (c != '\"') putchar(c);
- else {
- for (p = buffer; (c = getc(fd)) != '\"'; p++)
- if (c == EOF) {
- fprintf(stderr,"unexpected eof\n");
- exit(1);
- }
- else *p = c;
- *p = '\0';
- p = w_search(buffer, 0);
- if (p) printf("&x_str[%d]", p - &x_str[0]);
- else printf("\"%s\"", buffer);
- }
- }
-
- maketab(ifd, ofd, itab)
- FILE *ifd, *ofd;
- char *itab;
- { char wbuf[100], *p;
- int i;
-
- x_cmax = 0;
- if (ofd)
- fprintf(ofd, "char x_str[] = {");
- while (fgets(wbuf, 100, ifd) != NULL) {
- x_tab[++x_tmax] = &x_str[x_cmax];
- for (p = wbuf; *p; p++) {
- if (*p == '\n') {*p = '\0'; break;}
- if (ofd)
- fprintf(ofd,"0%o, ", *p);
- x_str[x_cmax++] = *p;
- }
- if (ofd)
- fprintf(ofd, "0, /* %s */\n", wbuf);
- x_str[x_cmax++] = '\0';
- }
- if (ofd) {
- fprintf(ofd, "0 };\n");
- fprintf(ofd, "int x_cmax = %d;\n", x_cmax);
- }
- if (itab) {
- fprintf(ofd, "static symbol x_sytab[] = {\n");
- for (i = 0; i <= x_tmax; i++) {
- fprintf(ofd, "{1, SYMBOLSIZE, &x_str[%d]}, /* ",
- x_tab[i]-x_tab[0]);
- for (p = x_tab[i]; *p; p++)
- putc(*p, ofd);
- fprintf(ofd," */\n");
- }
- fprintf(ofd, "0};\n");
- fprintf(ofd, "symbol *x_tab[%s] = {\n", itab);
- for (i = 0; i <= x_tmax; i++) {
- fprintf(ofd, "&x_sytab[%d], /* ",i);
- for (p = x_tab[i]; *p; p++)
- putc(*p, ofd);
- fprintf(ofd," */\n");
- }
- fprintf(ofd, "0};\n");
- fprintf(ofd,"int x_tmax = %d;\n", x_tmax);
- }
- }
-
- /*
- word search for table routines
- */
-
- char *w_search(word, insert)
- char *word;
- int insert;
- { int i,j,k;
-
- for (i=1; i <= x_tmax; i <<= 1);
- for (i >>= 1, j = i >>1, i--; ; j >>= 1) {
- if (! (k = strcmp(word, x_tab[i])))
- return(x_tab[i]);
-
- if (!j) break;
- if (k < 0) i -= j;
- else {
- if ((i += j) > x_tmax) i = x_tmax;
- }
- }
- if (insert) {
- for (k = ++x_tmax; k > i; k--) {
- x_tab[k] = x_tab[k-1];
- }
- if (!(x_tab[i] = (char *) malloc(1 + strlen(word))))
- return((char *) 0);
- strcpy(x_tab[i], word);
- return(x_tab[i]);
- }
- else return((char *) 0);
- }
- End
- echo unbundling symbols 1>&2
- cat >symbols <<'End'
- !
- &
- (
- )
- *
- +
- ,
- -
- /
- //
- <
- <=
- =
- ==
- >
- >=
- @
- Array
- ArrayedCollection
- BLOCKED
- Bag
- Block
- Boolean
- ByteArray
- Char
- Class
- Collection
- Complex
- Dictionary
- False
- File
- Float
- Integer
- Interpreter
- Interval
- KeyedCollection
- List
- Little Smalltalk
- Magnitude
- Main
- Number
- Object
- OrderedCollection
- Point
- Process
- READY
- Radian
- Random
- SUSPENDED
- Semaphore
- SequenceableCollection
- Set
- Smalltalk
- String
- Symbol
- TERMINATED
- True
- UndefinedObject
- [
- \\
- \\\\
- ]
- ^
- abs
- add:
- add:after:
- add:before:
- add:withOccurrences:
- addAll:
- addAllFirst:
- addAllLast:
- addFirst:
- addLast:
- after:
- allMask:
- and:
- anyMask:
- arcCos
- arcSin
- arcTan
- argerror
- asArray
- asBag
- asCharacter
- asDictionary
- asFloat
- asFraction
- asInteger
- asList
- asLowercase
- asOrderedCollection
- asSet
- asString
- asSymbol
- asUppercase
- asciiValue
- at:
- at:ifAbsent:
- at:put:
- atAll:put:
- atAllPut:
- before:
- between:and:
- binaryDo:
- bitAnd:
- bitAt:
- bitInvert
- bitOr:
- bitShift:
- bitXor:
- block
- blockedProcessQueue
- ceiling
- checkBucket:
- class
- cleanUp
- coerce:
- collect:
- commands:
- compareError
- copy
- copyArguments:
- copyArguments:to:
- copyFrom:
- copyFrom:length:
- copyFrom:to:
- copyWith:
- copyWithout:
- cos
- count
- currAssoc
- currBucket
- current
- currentBucket
- currentKey
- currentList
- date
- debug:
- deepCopy
- deepCopy:
- detect:
- detect:ifAbsent:
- detect:ifNone:
- dict
- dictionary
- digitValue
- digitValue:
- display
- displayAssign
- dist:
- do:
- doPrimitive:
- doPrimitive:withArguments:
- edit
- equals:startingAt:
- eqv:
- error:
- even
- excessSignals
- executeWith:
- exp
- factorial
- findAssociation:inList:
- findFirst:
- findFirst:ifAbsent:
- findLast
- findLast:
- findLast:ifAbsent:
- first
- firstKey
- floor
- floorLog:
- fork
- forkWith:
- fractionPart
- free:
- from:
- from:to:
- from:to:by:
- gamma
- gcd:
- getList:
- grid:
- hashNumber:
- hashTab
- hashTable
- highBit
- i
- ifFalse:
- ifFalse:ifTrue:
- ifTrue:
- ifTrue:ifFalse:
- inRange:
- includes:
- includesKey:
- indexOf:
- indexOf:ifAbsent:
- indexOfSubCollection:startingAt:
- indexOfSubCollection:startingAt:ifAbsent:
- init:
- init:super:
- init:super:numVars:
- inject:into:
- integerPart
- isAlphaNumeric
- isDigit
- isEmpty
- isKindOf:
- isLetter
- isLowercase
- isMemberOf:
- isNil
- isSeparator
- isUppercase
- isVowel
- keys
- keysDo:
- keysSelect:
- last
- lastKey
- lcm:
- list
- ln
- log:
- lower
- main
- max:
- maxContext:
- maxtype:
- methods:
- min:
- modeCharacter
- modeInteger
- modeString
- name:
- negated
- negative
- new
- new:
- newProcess
- newProcessWith:
- next
- next:
- noDisplay
- noMask:
- not
- notNil
- nothing
- occurrencesOf:
- odd
- opError
- open:
- open:for:
- or:
- perform:
- perform:withArguments:
- pi
- positive
- print
- printString
- put:
- quo:
- radians
- radix:
- raisedTo:
- raisedToInteger:
- randInteger:
- randomize
- read
- reciprocal
- reject:
- rem:
- remove:
- remove:ifAbsent:
- removeAll:
- removeError
- removeFirst
- removeKey:
- removeKey:ifAbsent:
- removeLast
- removed
- replaceFrom:to:with:
- replaceFrom:to:with:startingAt:
- respondsTo
- respondsTo:
- resume
- reverseDo:
- reversed
- roundTo:
- rounded
- sameAs:
- seed
- select:
- setCurrentLocation:
- sh:
- shallowCopy
- shallowCopy:
- sign
- signal
- sin
- size
- smalltalk
- sort
- sort:
- sqrt
- squared
- state
- step
- strictlyPositive
- superClass
- superClass:
- suspend
- tan
- temp
- termErr:
- terminate
- time:
- timesRepeat:
- to:
- to:by:
- transpose
- truncateTo:
- truncated
- truncatedGrid:
- unblock
- upper
- value
- value:
- value:value:
- value:value:value:
- value:value:value:value:
- value:value:value:value:value:
- values
- variables
- variables:
- view
- wait
- whileFalse:
- whileTrue:
- with:do:
- withArguments:
- write:
- x
- x:
- xor:
- xvalue
- y
- y:
- yield
- yvalue
- |
- ~
- ~=
- ~~
- End
- echo unbundling newmal.c 1>&2
- cat >newmal.c <<'End'
- /*
- From gi!sytek!menlo70!hao!seismo!harpo!utah-cs!thomas Thu Dec 16 14:08:48 1982
- Subject: New malloc subroutine
- Newsgroups: net.sources
-
- This malloc works much better in a VAX (paging) environment. I doubt it would
- work very well on a PDP-11 (in fact, the copymem routine uses an asm, so it
- will work only on a VAX without modification). Defining MSTATS causes
- some statistics to be kept, and the routine mstats(string) can be called
- to print them out. Defining rcheck causes more careful checking to be done,
- may help find bugs in code (I haven't used it). Note that the layout of
- the arena is QUITE different from the old malloc, so anything that depends
- on this will need to be rewritten. I make no guarantees, and it's not my
- code to begin with (I asked the author, whose name I have forgotten now,
- for permission to redistribute).
-
- -Spencer
- ================================================================
- */
- /* @(#)nmalloc.c 1 (Caltech) 2/21/82
- * This is a very fast storage allocator. It allocates blocks of a small
- * number of different sizes, and keeps free lists of each size. Blocks that
- * don't exactly fit are passed up to the next larger size. In this
- * implementation, the available sizes are (2^n)-4 (or -12) bytes long.
- * This is designed for use in a program that uses vast quantities of memory,
- * but bombs when it runs out. To make it a little better, it warns the
- * user when he starts to get near the end.
- */
-
- /* nextf[i] is the pointer to the next free block of size 2^(i+3). The
- * smallest allocatable block is 8 bytes. The overhead information will
- * go in the first int of the block, and the returned pointer will point
- * to the second.
- *
- #ifdef MSTATS
- * nmalloc[i] is the difference between the number of mallocs and frees
- * for a given block size.
- #endif MSTATS
- */
-
- static unsigned int *nextf[30];
-
- #define MSTATS
- #ifdef MSTATS
- static unsigned int nmalloc[30];
- #include "stdio.h"
- #endif MSTATS
-
- #include <sys/vlimit.h> /* warn the user when near the end */
- #ifdef debug
- #define ASSERT(p) if (!(p))botch("p"); else
- #else
- #define ASSERT(p)
- #endif
-
- extern char etext; /* end of the program */
- #define NULL 0
-
- #ifdef rcheck
- #define MAGIC 0x55555555
- #endif
-
- /* The overhead on a block will be four bytes long. When free, it will
- * contain a pointer to the next free block, and the bottom two bits must
- * be zero. When in use, the first byte will be set to 0xFF, and the second
- * byte will be the size index. The other two bytes are only used for
- * alignment. If you are range checking, and the size of the block will fit
- * into two bytes, then the top two bytes hold the size of the requested block
- * plus the range checking words, and the header word MINUS ONE.
- */
-
- static *morecore(nu) /* ask system for more memory */
- register int nu; /* size index to get more of */
- { char *sbrk();
- register unsigned int *cp;
- register int rnu; /* 2^rnu bytes will be requested */
- register int nblks; /* that becomes nblks blocks of the desired size */
- register int siz; /* size in ints, not bytes */
- static int warnlevel=0;
- register int used;
-
- if (nextf[nu]!=NULL)
- return;
-
- siz=vlimit(LIM_DATA,-1); /* find out how much we can get */
- cp=((unsigned int *)sbrk(0));
- used=(int)cp;
- used-= (int)&etext;
- switch (warnlevel){
- case 0:
- if (used>(siz/4)*3){
- write(2,"warning: past 75% of memory limit\7\n",35);
- warnlevel=1;}
- break;
- case 1:
- if (used>(siz/20)*17){
- write(2,"warning: past 85% of memory limit\7\n",35);
- warnlevel=2;}
- break;
- case 2:
- if (used>(siz/20)*19){
- write(2,"warning: past 95% of memory limit\7\n",35);
- warnlevel=3;}
- break;
- } /* end of warning switch */
- if ((((int)cp)&0x3ff) != 0) /* land on 1K boundaries */
- sbrk(1024-(((int)cp)&0x3ff));
-
- rnu=(nu<=8)?11:nu+3; /* take 2k unless the block is bigger than that */
- nblks=1<<(rnu-(nu+3)); /* how many blocks to get */
- if (rnu<nu) rnu=nu;
- if ((int)(cp=(unsigned int*)sbrk(1<<rnu)) == -1) /* no more room! */
- return;
- if ((((int)cp) & 7)!=0){
- cp=(unsigned int*)((((int)cp)+8)&~7);
- nblks--;}
- nextf[nu]=cp;
- siz= 1<<(nu+1);
- while (--nblks>0){
- ((unsigned int**)cp)[0]= &cp[siz];
- cp= (unsigned int*)&cp[siz];}
- }
-
- char *malloc(nbytes) /* get a block */
- register unsigned nbytes;
- {
- register unsigned char *p;
- register int nunits=0;
- register unsigned shiftr;
-
- #ifdef rcheck
- nbytes+=12; /* make sure the range checkers will fit */
- #else
- nbytes+=4; /* add on for the overhead */
- #endif
- nbytes=(nbytes+3)&~3; /* round up, but still measure in bytes */
- shiftr=(nbytes-1)>>2;
- while ((shiftr>>=1)!=0) /* apart from this loop, this is O(1) */
- nunits++;
- if (nextf[nunits]==NULL) /* needed block, nunits is the size index */
- morecore(nunits);
- if ((p=(unsigned char*)(nextf[nunits]))==NULL)
- return(NULL);
- nextf[nunits]= (unsigned int*)*nextf[nunits];
- p[0]=0xff;
- p[1]=nunits;
- #ifdef MSTATS
- nmalloc[nunits]++;
- #endif MSTATS
- #ifdef rcheck
- if (nbytes<=0x10000)
- ((unsigned short*)p)[1]=(unsigned short)nbytes-1;
- *((int*)(p+4))=MAGIC;
- *((int*)(p+nbytes-4))=MAGIC;
- return((char*)(p+8));
- #else
- return((char*)(p+4));
- #endif
- }
-
- free(ap)
- register unsigned char *ap;
- { register int si;
-
- if (ap==NULL)
- return;
- #ifdef rcheck
- ap-=4;
- ASSERT(*(int*)ap==MAGIC);
- #endif
- ap-=4; /* point back to overhead word */
- #ifdef debug
- ASSERT(ap[0]==0xff); /* make sure it was in use */
- #else
- if (ap[0]!=0xff)
- return;
- #endif
- #ifdef rcheck
- if (ap[1]<=13){
- si=((unsigned short *)ap)[1]-11; /* get the size of the data */
- ASSERT(*((int*)(ap+si+8))==MAGIC); /* check for overflow */
- }
- #endif
- ASSERT(ap[1]<=29);
- si=ap[1];
- *((unsigned int**)ap)=nextf[si];
- nextf[si]=(unsigned int*)ap;
- #ifdef MSTATS
- nmalloc[si]--;
- #endif MSTATS
- }
-
- char *realloc(p, nbytes)
- register char *p; register unsigned nbytes;
- { register char *res;
- register unsigned int onb;
-
- if (p==NULL)
- return(malloc(nbytes));
- #ifdef rcheck
- if (p[-7]<13)
- onb= ((unsigned short*)p)[-3]-11; /* old number of data bytes only */
- else
- onb=(1<<(p[-7]+3))-12;
- #else
- onb=(1<<(p[-3]+3))-4;
- #endif
- if ((res=malloc(nbytes))==NULL)
- return(NULL);
- copymem((nbytes<onb)?nbytes:onb,p,res);
- free(p);
- return(res);
- }
-
- copymem(n, from, to)
- int n;
- register char * from, * to;
- {
- register int i;
-
- while (n > 0)
- {
- i = n > 65535L ? 65535L : n;
- asm(" movc3 r9,(r11),(r10)"); /* glug! */
- n -= i;
- from += i;
- to += i;
- }
- }
-
- #ifdef MSTATS
- /* ****************************************************************
- * mstats - print out statistics about malloc
- *
- * Prints two lines of numbers, one showing the length of the free list
- * for each size category, the second showing the number of mallocs -
- * frees for each size category.
- */
-
- mstats(s)
- char *s;
- {
- register int i, j;
- register unsigned int * p;
- int totfree = 0,
- totused = 0;
-
- fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s);
- for (i=0; i<30; i++)
- {
- for (j=0, p=nextf[i]; p; p = (unsigned int *)*p, j++)
- ;
- fprintf(stderr, " %d", j);
- totfree += j * (1 << (i+3));
- }
- fprintf(stderr, "\nused:\t");
- for (i=0; i<30; i++)
- {
- fprintf(stderr, " %d", nmalloc[i]);
- totused += nmalloc[i] * (1 << (i+3));
- }
- fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n");
- }
- #else
- mstats()
- { /* dummy to keep people happy */
- }
- #endif
-
- End
- echo unbundling main.c 1>&2
- cat >main.c <<'End'
- /*
- Little Smalltalk -
- main driver
-
- timothy a. budd
-
- 1. initializes various smalltalk constants and classes with
- legitimate values. these values, however, will for the most part
- be overridden when the standard prelude is read in.
-
- 2. reads in the standard prelude, plus any additional files listed
- on the command line.
-
- 3. places the driver reading stdin on the process queue and starts
- the process driver running.
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
-
- int version = 2; /* a Kludge to get us the start of the data segment.
- used to save and restore contexts */
-
-
- # include <stdio.h>
- # include "object.h"
- # include "string.h"
- # include "symbol.h"
- # include "interp.h"
- # include "primitive.h"
-
- static object *null_object; /* a totally classless object */
- static char filebase[80]; /* base for forming temp file names */
-
- extern int n_incs, n_decs, n_mallocs; /* counters */
- extern int opcount[], ohcount, spcount[];
-
- extern int ca_block, ca_barray, ca_class, ca_terp, ca_int, ca_float;
- extern int ca_obj, ca_str, ca_sym, ca_wal, ca_cdict;
- extern int ca_cobj[];
- extern int btabletop, wtop; /* more counters */
-
- # ifdef INLINE
- object *_dx; /* object pointer used for decrementing */
- # endif
-
- int silence = 0; /* 1 if silence is desired on output */
- int noload = 0; /* 1 if no loading of standard prelude is desired */
- int debug = 0; /* debug flag, set by a primitive call */
- int fastload = 0; /* 1 if doing a fast load of saved image */
- int lexprnt = 0; /* 1 if printing during lex is desired (for debug) */
- int prallocs = 0; /* 1 if printing final allocation figures is wanted */
- int started = 0; /* 1 if we have started reading user commands */
- int prntcmd = 1; /* 1 or 2 and commands will be printed as evaled */
-
- /* pseudo-variables */
- object *o_acollection; /* arrayed collection (used internally) */
- object *o_drive; /* driver interpreter */
- object *o_empty; /* the empty array (used during initial) */
- object *o_false; /* value for pseudo variable false */
- object *o_magnitude; /* instance of class Magnitude */
- object *o_nil; /* value for pseudo variable nil */
- object *o_number; /* instance of class Number */
- object *o_object; /* instance of class Object */
- object *o_tab; /* string with tab only */
- object *o_true; /* value of pseudo variable true */
- object *o_smalltalk; /* value of pseudo variable smalltalk */
-
- /* classes to be initialized */
- extern class *Array;
- extern class *ArrayedCollection;
-
- /* input stack */
- extern FILE *fdstack[];
- extern int fdtop;
-
- /* main - main driver */
- main(argc, argv)
- int argc;
- char **argv;
- { int i;
- class *null_class();
- object *tempobj;
- FILE *sfd;
-
- # ifdef FASTDEFAULT
- fastload = 1;
- # endif
- # ifndef FASTDEFAULT
- fastload = 0;
- # endif
-
- /* first check for flags */
- for (i = 1; i < argc; i++)
- if (argv[i][0] == '-')
- switch(argv[i][1]) {
- case 'f': fastload = 1; break;
- case 'l': /* fall through */
- case 'n': noload = 1; /* fall through */
- case 'm': fastload = 0; break;
- case 'z': lexprnt = 1; break;
- }
-
- if (fastload) {
- dofast();
- }
- else { /* gotta do it the hard way */
- strcpy(filebase, TEMPFILE);
- mktemp(filebase);
-
- byte_init();
- class_init();
- cdic_init();
- int_init();
- str_init();
- sym_init();
- init_objs();
-
- null_object = new_obj((class *) 0, 0, 0);
-
- sassign(o_object, null_object);
- /* true is given a different object from others , so comparisons
- work correctly */
- sassign(o_true, new_obj((class *) 0, 0, 0));
- sassign(o_false, null_object);
- sassign(o_nil, null_object);
- sassign(o_number, null_object);
- sassign(o_magnitude, null_object);
- sassign(o_empty, null_object);
- sassign(o_smalltalk, null_object);
- sassign(o_acollection, null_object);
-
- sassign(Array, null_class("Array"));
- sassign(ArrayedCollection, null_class("ArrayedCollection"));
-
- drv_init(); /* initialize the driver */
- sassign(o_drive, (object *) cr_interpreter((interpreter *) 0,
- null_object, null_object, null_object, null_object));
- init_process((interpreter *) o_drive);
-
- /* now read in standard prelude */
- if (! noload) {
- sfd = fopen(PRELUDE, "r");
- if (sfd == NULL) cant_happen(20);
- set_file(sfd);
- start_execution();
- fclose(sfd);
- }
-
- /* then set lexer up to read stdin */
- set_file(stdin);
- sassign(o_tab, new_str("\t"));
-
- # ifdef CURSES
- /* finally initialize the curses window package */
- initscr();
- # endif
- # ifdef PLOT3
- /* initialize the plotting device */
- openpl();
- # endif
- }
-
- /* announce that we're ready for action */
- sassign(tempobj, new_sym("Little Smalltalk"));
- primitive(SYMPRINT, 1, &tempobj);
- obj_dec(tempobj);
- started = 1;
-
- /* now read in the command line files */
- user_read(argc, argv);
-
- start_execution();
-
- /* print out one last newline - to move everything out of output
- queue */
- sassign(tempobj, new_sym("\n"));
- primitive(SYMPRINT, 1, &tempobj);
- obj_dec(tempobj);
-
- /* now free things up, hopefully keeping ref counts straight */
-
- drv_free();
-
- flush_processes();
-
- free_low_nums();
-
- obj_dec((object *) Array);
- obj_dec((object *) ArrayedCollection);
-
- free_all_classes();
-
- obj_dec(o_tab);
- obj_dec(o_drive);
- obj_dec(o_magnitude);
- obj_dec(o_number);
- obj_dec(o_nil);
- obj_dec(o_false);
- obj_dec(o_true);
- obj_dec(o_object);
- obj_dec(o_empty);
- obj_dec(o_smalltalk);
- obj_dec(o_acollection);
-
- if (! silence)
- fprintf(stderr,"incs %u decs %u difference %d allocs %d\n",
- n_incs, n_decs, n_incs - n_decs, n_mallocs);
- ohcount = 0;
- for (i = 0; i < 16; i++)
- ohcount += opcount[i];
- fprintf(stderr,"opcount %d\n", ohcount);
- /*fprintf(stderr,"opcode [%d] counts %d\n", i, opcount[i]);*/
- /*fprintf(stderr,"ohcount %d\n", ohcount);
- for (i = 0; i < 16; i++)
- fprintf(stderr,"sp count %d %d\n", i , spcount[i]);*/
- if (prallocs) {
- fprintf(stderr,"blocks allocated %d\n", ca_block);
- fprintf(stderr,"bytearrays allocated %d\n", ca_barray);
- fprintf(stderr,"classes allocated %d\n", ca_class);
- fprintf(stderr,"interpreters allocated %d\n", ca_terp);
- fprintf(stderr,"ints allocated %d\n", ca_int);
- fprintf(stderr,"floats allocated %d\n", ca_float);
- fprintf(stderr,"strings allocated %d\n", ca_str);
- fprintf(stderr,"symbols allocated %d\n", ca_sym);
- fprintf(stderr,"class entryies %d\n", ca_cdict);
- fprintf(stderr,"wallocs %d\n", ca_wal);
- fprintf(stderr,"wtop %d\n", wtop);
- fprintf(stderr,"byte table top %d\n", btabletop);
- fprintf(stderr,"smalltalk objects allocated %d\n", ca_obj);
- for (i = 0; i < 5; i++)
- fprintf(stderr,"size %d objects %d\n", i, ca_cobj[i]);
- }
- clean_files();
-
- # ifdef PLOT3
- closepl();
- # endif
- # ifdef CURSES
- endwin();
- # endif
-
- exit(0); /* say good by gracie */
- }
-
- /* dofast - do a fast load of the standard prelude */
- static dofast() {
- char buffer[100];
-
- sprintf(buffer,")l %s\n", FAST);
- dolexcommand(buffer);
- }
-
- /* null_class - create a null class for bootstrapping purposes */
- static class *null_class(name)
- char *name;
- { class *new, *new_class();
-
- new = new_class();
- assign(new->class_name, new_sym(name));
- enter_class(name, (object *) new);
- return(new);
- }
-
- /* user_read - read the user command line arguments */
- static user_read(argc, argv)
- int argc;
- char **argv;
- { int i, count;
- char c, buffer[100];
- char name[100];
- FILE *fd = 0;
-
- gettemp(name);
- count = 0;
- fd = fopen(name, "w");
- if (fd == NULL)
- cant_happen(22);
- for (i = 1; i < argc; i++)
- if (argv[i][0] == '-') {
- switch(argv[i][1]) {
- case 'a':
- prallocs = 1; break;
- case 'g': case 'l': case 'r':
- c = argv[i][1];
- sprintf(buffer,")%c %s\n",
- c, argv[++i]);
- count++;
- fputs(buffer, fd);
- break;
- case 'd':
- prntcmd = argv[i][1] - '0';
- break;
- case 's':
- silence = 1;
- break;
- }
- }
- else {
- sprintf(buffer,")i %s\n", argv[i]);
- count++;
- fputs(buffer, fd);
- }
- fclose(fd);
- if (count) {
- fd = fopen(name, "r");
- if (fd == NULL)
- cant_happen(22);
- set_file(fd);
- }
- }
-
- /* gettemp makes a temp file name that can be deleted when finished */
- static char c = 'a';
- gettemp(buffer)
- char *buffer;
- {
- sprintf(buffer,"%s%c", filebase, c++);
- if (c > 'z') c = 'a'; /* wrap around forever */
- }
-
- /* clean_files - delete all temp files created */
- static clean_files()
- {
- char buffer[100];
-
- # ifndef NOSYSTEM
- sprintf(buffer,"rm -f %s*", filebase);
- system(buffer);
- # endif
- }
- End
- echo unbundling object.c 1>&2
- cat >object.c <<'End'
- /*
- Little Smalltalk
-
- object memory management
-
- timothy a. budd, 10/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "drive.h"
- # include "string.h"
- # include "symbol.h"
- # include "byte.h"
- # include "number.h"
- # include "interp.h"
- # include "process.h"
- # include "block.h"
- # include "file.h"
- # include "primitive.h"
-
- # define DEBUG 0
-
- extern object *o_acollection;
-
- int n_incs = 0; /* number of increments counter */
- int n_decs = 0; /* number of decrements counter (should be equal)*/
- int n_mallocs = 0; /* number of mallocs counter */
-
- /* o_alloc - allocate a block of memory, checking for end of memory */
- char *o_alloc(n)
- unsigned n;
- { char *p, *malloc();
-
- p = malloc(n);
- if (p == (char *) 0) cant_happen(1); /* out of memory */
- n_mallocs++;
- return(p);
- }
-
- #ifndef INLINE
-
- /* obj_inc - increment an object (usually expanded in-line) */
- obj_inc(x)
- register object *x;
- {
- x->ref_count++;
- n_incs++;
- }
-
- /* obj_dec - decrement an object (usually half expanded in-line) */
- obj_dec(x)
- object *x;
- {
- n_decs++;
- if (--(x->ref_count) > 0) return;
- # endif
- # ifdef INLINE
- ob_dec(x)
- object *x;
- {
- # endif
- if (x->ref_count < 0) {
- fprintf(stderr,"ref count %d %d\n", x->ref_count, x);
- primitive(REFCOUNTERROR, 1, &x);
- return;
- }
- if (is_bltin(x)) { /* free a built-in object */
- switch(x->size) {
- case BLOCKSIZE:
- free_block(x); break;
- case BYTEARRAYSIZE:
- free_bytearray((bytearray *) x); break;
- case CLASSSIZE :
- free_class((class *) x); break;
- case FILESIZE:
- free_file((struct file_struct *) x);
- break;
- case FLOATSIZE:
- free_float((sfloat *) x); break;
- case INTEGERSIZE: case CHARSIZE:
- free_integer((integer *) x); break;
- case INTERPSIZE:
- free_terpreter((interpreter *) x); break;
- case PROCSIZE:
- free_process((process *) x); break;
- case SYMBOLSIZE:
- cant_happen(16);
- case STRINGSIZE:
- free_string((string *) x); break;
- default: cant_happen(6);
- }
- }
- else { /* free a normal (non-special) object */
- if (x->super_obj)
- obj_dec(x->super_obj);
- free_obj(x, 1);
- }
- }
-
- # define MAXOBJLIST 100
- # define sizeobj(x) (sizeof(object) + ((x) - 1) * sizeof(object *) )
-
- /* obj_free_list is a free list for memory blocks */
-
- static object *obj_free_list[MAXOBJLIST]; /* better be initialized to zero! */
-
- int ca_obj = 0; /* count the number of allocations made */
- int ca_cobj[5] = {0,0,0,0,0}; /* count how many allocations for small vals*/
-
- /* make sure the following list is null terminated! */
- int size_obj_init[] = {15, 75, 420, 10, 10, 5, 0};
-
- /* init_objs - initialize the memory management module */
- init_objs() {
- int i, j, max, size;
- char *p;
- object *new;
-
- for (i = 0; (max = size_obj_init[i]); i++) {
- size = sizeobj(i);
- p = o_alloc((unsigned int) (max * size));
- for (j = 0; j < max; j++) {
- new = (object *) p;
- new->super_obj = obj_free_list[i];
- obj_free_list[i] = new;
- p += size;
- }
- }
- }
-
- /* new_obj - create a new non-special object */
- object *new_obj(nclass, nsize, alloc)
- class *nclass;
- int nsize, alloc;
- { register object *new;
- int i;
-
- if (nsize < 0)
- cant_happen(2);
- if (nsize < MAXOBJLIST && obj_free_list[nsize])
- obj_free_list[nsize] = (new = obj_free_list[nsize])->super_obj;
- else {
- new = (object *) o_alloc(sizeobj(nsize));
- ca_obj++;
- if (nsize < 5)
- ca_cobj[nsize]++;
- }
- new->super_obj = (object *) 0;
- new->class = nclass;
- if (nclass)
- obj_inc((object *) new->class );
- new->ref_count = 0;
- new->size = nsize;
- if (alloc)
- for (i = 0; i < nsize; i++) {
- sassign(new->inst_var[ i ], o_nil);
- }
- return(new);
- }
-
- /* free_obj - free a non-special object */
- free_obj(obj, dofree)
- register object *obj;
- int dofree;
- { int size, i;
-
- size = obj->size;
- if (dofree)
- for (i = 0; i < size; i++)
- obj_dec(obj->inst_var[i]);
- if (obj->class)
- obj_dec((object *) obj->class);
- if (size < MAXOBJLIST) {
- obj->super_obj = obj_free_list[size];
- obj_free_list[size] = obj;
- }
- else {
- free(obj);
- }
- }
-
- /* fnd_class - find the class of a special object */
- object *fnd_class(anObject)
- object *anObject;
- { object *result, *lookup_class();
- char *name;
-
- if (is_bltin(anObject)) {
- switch(anObject->size) {
- case BLOCKSIZE: name = "Block"; break;
- case CLASSSIZE: name = "Class"; break;
- case FILESIZE: name = "File"; break;
- case FLOATSIZE: name = "Float"; break;
- case INTEGERSIZE: name = "Integer"; break;
- case CHARSIZE: name = "Char"; break;
- case INTERPSIZE: name = "Interp"; break;
- case PROCSIZE: name = "Process"; break;
- case SYMBOLSIZE: name = "Symbol"; break;
- case STRINGSIZE: name = "String"; break;
- case BYTEARRAYSIZE: name = "ByteArray"; break;
- default: cant_happen(6);
- }
- result = lookup_class(name);
- }
- else
- result = (object *) anObject->class;
- return(result);
- }
-
- extern object *o_object, *o_magnitude, *o_number;
-
- /* fnd_super - produce a super-object for a special object */
- object *fnd_super(anObject)
- object *anObject;
- { object *result;
-
- if (is_bltin(anObject)) {
- switch(anObject->size) {
- case BLOCKSIZE: result = o_object; break;
- case CLASSSIZE: result = o_object; break;
- case FILESIZE: result = o_object; break;
- case FLOATSIZE: result = o_number; break;
- case INTEGERSIZE: result = o_number; break;
- case CHARSIZE: result = o_magnitude; break;
- case INTERPSIZE: result = o_object; break;
- case PROCSIZE: result = o_object; break;
- case SYMBOLSIZE: result = o_object; break;
- case STRINGSIZE: /* strings DO have superobjs*/
- result = ((string *) anObject)->s_super_obj;
- break;
- case BYTEARRAYSIZE: result = o_acollection; break;
- default: cant_happen(6);
- }
- }
- else
- result = anObject->super_obj;
- return(result);
- }
- End
- echo unbundling line.c 1>&2
- cat >line.c <<'End'
- /*
- Little Smalltalk
-
- line grabber - does lowest level input for command lines.
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "primitive.h"
-
- # define MAXINCLUDE 10
- # define MAXBUFFER 1200 /* text buffer */
-
- static FILE *fdstack[MAXINCLUDE];
- static int fdtop = -1;
-
- static char buffer[MAXBUFFER];
- static char *buftop = buffer;
- char *lexptr = buffer;
- static enum {empty, half, filled} bufstate = empty;
- int inisstd = 0;
- extern object *o_tab;
-
- /* set file - set a file on the file descriptor stack */
- set_file(fd)
- FILE *fd;
- {
- if ((++fdtop) > MAXINCLUDE)
- cant_happen(18);
- fdstack[fdtop] = fd;
- if (fd == stdin) inisstd = 1;
- else inisstd = 0;
- }
-
- /* line-grabber - read a line of text
- do blocked i/o if blocked is nonzero,
- otherwise do non-blocking i/o */
-
- int line_grabber(block)
- int block;
- {
- /* if it was filled last time, it is now empty */
- if (bufstate == filled) {
- bufstate = empty;
- buftop = buffer;
- lexptr = buffer;
- }
-
- if ( ! block)
- return(0); /* for now, only respond to blocked requests*/
- else while (bufstate != filled) {
- if (fdtop < 0) {
- fprintf(stderr,"no files to read\n");
- return(-1);
- }
- if (inisstd && o_tab)
- primitive(RAWPRINT, 1, &o_tab);
- if (fgets(buftop, MAXBUFFER, fdstack[fdtop]) == NULL) {
- bufstate = empty;
- if (fdstack[fdtop] != stdin)
- fclose(fdstack[fdtop]);
- if (--fdtop < 0) return(-1);
- inisstd = (fdstack[fdtop] == stdin);
- }
- else {
- bufstate = half;
- while (*buftop) buftop++;
- if (*(buftop-1) == '\n') {
- if (*(buftop-2) == '\\') {
- buftop -= 2;
- }
- else {
- if ((buftop - buffer) > MAXBUFFER)
- cant_happen(18);
- *buftop = '\0';
- bufstate = filled;
- }
- }
- }
- }
- return(bufstate == filled);
- }
- End
- echo unbundling class.c 1>&2
- cat >class.c <<'End'
- /*
- Little Smalltalk
- class instance creation and deletion
-
- timothy a. budd 10/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "file.h"
- # include "number.h"
- # include "symbol.h"
- # include "string.h"
- # include "primitive.h"
- # define streq(x,y) (strcmp(x,y) == 0)
-
- extern class *Array, *ArrayedCollection;
-
- extern object *o_object, *o_empty, *o_number, *o_magnitude;
- extern object *o_smalltalk, *o_acollection;
-
- static mstruct *fr_class = 0;
- int ca_class = 0; /* count class allocations */
-
- # define CLASSINITMAX 30
-
- static class cl_table[CLASSINITMAX];
-
- class_init()
- { class *p;
- mstruct *new;
- int i;
-
- for (p = cl_table, i = 0; i < CLASSINITMAX; i++, p++) {
- new = (mstruct *) p;
- new->mlink = fr_class;
- fr_class = new;
- }
- }
-
- class *new_class()
- { class *new;
-
- if (fr_class) {
- new = (class *) fr_class;
- fr_class = fr_class->mlink;
- }
- else {
- new = structalloc(class);
- ca_class++;
- }
-
- new->c_ref_count = 0;
- new->c_size = CLASSSIZE;
- sassign(new->file_name, o_nil);
- sassign(new->class_name, o_nil);
- new->super_class = (object *) 0;
- sassign(new->c_inst_vars, o_nil);
- new->context_size = 0;
- sassign(new->message_names, o_nil);
- sassign(new->methods, o_nil);
- return(new);
- }
-
- class *mk_class(classname, args)
- char *classname;
- object **args;
- { class *new;
- object *new_iarray();
-
- new = new_class();
- assign(new->class_name, args[0]);
- if (! streq(classname, "Object"))
- sassign(new->super_class, args[1]);
- assign(new->file_name, args[2]);
- assign(new->c_inst_vars, args[3]);
- assign(new->message_names, args[4]);
- assign(new->methods, args[5]);
- new->context_size = int_value(args[6]);
- new->stack_max = int_value(args[7]);
-
- if (streq(classname, "Array")) {
- assign(Array, new);
- assign(o_empty, new_iarray(0));
- }
- else if (streq(classname, "ArrayedCollection")) {
- assign(ArrayedCollection, new);
- assign(o_acollection, new_inst(new));
- assign(o_empty, new_iarray(0));
- }
- else if (streq(classname, "False"))
- assign(o_false, new_inst(new))
- else if (streq(classname, "Magnitude"))
- assign(o_magnitude, new_inst(new))
- else if (streq(classname, "Number"))
- assign(o_number, new_inst(new))
- else if (streq(classname, "Object"))
- assign(o_object, new_inst(new))
- else if (streq(classname, "Smalltalk"))
- assign(o_smalltalk, new_inst(new))
- else if (streq(classname, "True"))
- assign(o_true, new_inst(new))
- else if (streq(classname, "UndefinedObject"))
- assign(o_nil, new_inst(new))
- return(new);
- }
-
- /* new_sinst - new instance with explicit super object */
- object *new_sinst(aclass, super)
- class *aclass;
- object *super;
- { object *new;
- char *classname, buffer[80];
-
- if (! is_class(aclass))
- cant_happen(4);
- classname = symbol_value(aclass->class_name);
- if ( streq(classname, "Block") ||
- streq(classname, "Char") ||
- streq(classname, "Class") ||
- streq(classname, "Float") ||
- streq(classname, "Integer") ||
- streq(classname, "Process") ||
- streq(classname, "Symbol") ) {
- sprintf(buffer,"%s: does not respond to new", classname);
- sassign(new, new_str(buffer));
- primitive(ERRPRINT, 1, &new);
- obj_dec(new);
- if (super) /* get rid of unwanted object */
- {obj_inc((object *) super);
- obj_dec((object *) super);}
- new = o_nil;
- }
- else if (streq(classname, "File")) {
- new = new_file();
- if (super) /* get rid of unwanted object */
- {obj_inc((object *) super);
- obj_dec((object *) super);}
- }
- else if (streq(classname, "String")) {
- new = new_str("");
- if (super)
- assign(((string *) new)->s_super_obj, super);
- }
- else {
- new = new_obj(aclass, (aclass->c_inst_vars)->size, 1);
- if (super)
- sassign(new->super_obj, super);
- }
- return(new);
- }
-
- object *new_inst(aclass)
- class *aclass;
- { object *super, *sp_class_name, *lookup_class();
- class *super_class;
-
- if (! is_class(aclass))
- cant_happen(4);
- if (aclass == o_object->class)
- return(o_object);
- super = (object *) 0;
- sp_class_name = aclass->super_class;
- if (sp_class_name && is_symbol(sp_class_name)) {
- super_class = (class *)
- lookup_class(symbol_value(sp_class_name));
- if (super_class && is_class(super_class))
- super = new_inst(super_class);
- }
- return(new_sinst(aclass, super));
- }
-
- free_class(c)
- class *c;
- {
- if (! is_class(c))
- cant_happen(8);
- obj_dec(c->class_name);
- if (c->super_class)
- obj_dec((object *) c->super_class);
- obj_dec(c->file_name);
- obj_dec(c->c_inst_vars);
- obj_dec(c->message_names);
- obj_dec(c->methods);
- ((mstruct *) c )->mlink = fr_class;
- fr_class = (mstruct *) c;
- }
- End
- echo unbundling number.c 1>&2
- cat >number.c <<'End'
- /*
- Little Smalltalk
-
- number definitions
- timothy a. budd, 10/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "number.h"
-
- # define MAXLOW 100 /* maximum low numbers kept */
-
- static integer *low_nums[MAXLOW]; /* better be initialized to zero ! */
-
- static mstruct *fr_integer = 0;
- static mstruct *fr_float = 0;
-
- static integer init_itable[INTINITMAX];
-
- int_init() {
- integer *p;
- mstruct *new;
- int i;
-
- for (p = init_itable, i = 0; i < INTINITMAX; i++, p++) {
- new = (mstruct *) p;
- new->mlink = fr_integer;
- /*fprintf(stderr,"init int %d %d\n", new, new->mlink);*/
- fr_integer = new;
- }
- }
-
- int ca_int = 0; /* count the number of integer allocations */
-
- extern object *o_magnitude;
- extern object *o_number;
-
- /* new_cori - new character or integer */
- object *new_cori(val, type)
- int val, type;
- { register integer *new;
-
- if ((type == 1) && (val >= 0 && val < MAXLOW) && low_nums[val])
- return( (struct obj_struct *) low_nums[val]);
-
- if (fr_integer) {
- new = (integer *) fr_integer;
- /*fprintf(stderr,"int off list %d %d\n", fr_integer,
- fr_integer->mlink);*/
- fr_integer = fr_integer->mlink;
- }
- else {
- new = structalloc(integer);
- /*fprintf(stderr,"allocating new int %d\n", new);*/
- ca_int++;
- }
-
- new->i_ref_count = 0;
- new->i_value = val;
- switch(type) {
- case 0: /* chars */
- new->i_size = CHARSIZE;
- break;
-
- case 1: /* integers */
- new->i_size = INTEGERSIZE;
- if (val >= 0 && val < MAXLOW)
- sassign(low_nums[val], new);
- break;
-
- default: cant_happen(5);
- }
- return ((object *) new);
- }
-
- free_integer(i)
- integer *i;
- {
- if ((! is_integer(i)) && (! is_character(i)))
- cant_happen(8);
- ((mstruct *) i)->mlink = fr_integer;
- fr_integer = (mstruct *) i;
- /*fprintf(stderr,"freeing integer %d %d\n", fr_integer,
- fr_integer->mlink);*/
- }
-
- free_low_nums()
- { int i;
-
- for (i = 0; i < MAXLOW; i++)
- if (low_nums[i]) {
- obj_dec((object *) low_nums[i]);
- low_nums[i] = (integer *) 0;
- }
- }
-
- int ca_float = 0;
-
- /* new_float - produce a new floating point number */
- object *new_float(val)
- double val;
- { register sfloat *new;
-
- if (fr_float) {
- new = (sfloat *) fr_float;
- fr_float = fr_float->mlink;
- }
- else {
- new = structalloc(sfloat);
- ca_float++;
- }
-
- new->f_ref_count = 0;
- new->f_size = FLOATSIZE;
- new->f_value = val;
- return( (object *) new);
- }
-
- free_float(f)
- sfloat *f;
- {
- if (! is_float(f))
- cant_happen(8);
- ((mstruct *) f)->mlink = fr_float;
- fr_float = (mstruct *) f;
- }
- End
- echo unbundling symbol.c 1>&2
- cat >symbol.c <<'End'
- /*
- Little Smalltalk
-
- symbol creation - symbols are never deleted once created.
- timothy a. budd, 10/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "symbol.h"
-
- /*
- only one copy of symbol values are kept.
- multiple copies of the same symbol point to the same
- location.
- sy_search will find, and if necessary insert, a string into
- this common table
- */
-
- extern char x_str[]; /* initialized common string table */
- extern symbol *x_tab[]; /* initialized common symbols table */
- extern int x_tmax; /* top of symbols table */
- extern char *walloc(); /* routine to allocate a new word */
- int ca_sym = 0; /* symbol allocation counter */
-
- /* sy_search performs a binary search of a symbol, is the main interface to
- the symbols routines */
- symbol *sy_search(word, insert)
- char *word;
- int insert;
- { register int i;
- register int j;
- register int k;
- char *p;
- symbol *new_y();
-
- for (i=1; i <= x_tmax; i <<= 1);
- for (i >>= 1, j = i >>1, i--; ; j >>= 1) {
- p = symbol_value(x_tab[i]);
- if (word == p) return(x_tab[i]);
- k = *word - *p;
- if (!k) k = *(word+1) - *(p+1);
- if (!k) k = strcmp(word, p);
- if (!k)
- return(x_tab[i]);
- if (!j) break;
- if (k < 0) i -= j;
- else {
- if ((i += j) > x_tmax) i = x_tmax;
- }
- }
- if (insert) {
- if (k > 0) i++;
- if ((k = ++x_tmax) >= SYMTABMAX)
- cant_happen(12);
- for (; k > i; k--) {
- x_tab[k] = x_tab[k-1];
- }
- /*fprintf(stderr,"adding %s\n", word);*/
- x_tab[i] = new_y(walloc(word));
- x_tab[i]->y_ref_count++; /* make sure not freed */
- return(x_tab[i]);
- }
- else return((symbol *) 0);
- }
-
- /* w_search performs a search for a word, not a symbol */
- char *w_search(word, insert)
- char *word;
- int insert;
- { symbol *sym;
-
- sym = sy_search(word, insert);
- if (sym)
- return(symbol_value(sym));
- else
- return((char *) 0);
- }
-
- /*---------------------------------------*/
-
- static mstruct *fr_symbol = 0; /* symbols free list */
- static symbol strspace[SYMINITSIZE]; /* initial symbols free list */
-
- extern object *o_object; /* common instance of Object */
- extern class *ArrayedCollection;
-
- /* sym_init - initialize the symbols routine */
- sym_init() {
- int i;
- symbol *p;
- mstruct *new;
-
- p = strspace;
- for (i = 0; i < SYMINITSIZE; i++) {
- new = (mstruct *) p;
- new->mlink = fr_symbol;
- fr_symbol = new;
- p++;
- }
- }
-
- /* new_y is the internal routine for making new symbols */
- symbol *new_y(text)
- char *text;
- { symbol *new;
-
- if (fr_symbol) {
- new = (symbol *) fr_symbol;
- fr_symbol = fr_symbol->mlink;
- }
- else {
- ca_sym++;
- new = structalloc(symbol);
- }
-
- new->y_ref_count = 0;
- new->y_size = SYMBOLSIZE;
- new->y_value = text;
- return(new);
- }
- End
- echo unbundling string.c 1>&2
- cat >string.c <<'End'
- /*
- Little Smalltalk
-
- string creation and deletion
- timothy a. budd, 10/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "string.h"
-
- int ca_str = 0;
- int ca_wal = 0;
-
- /* walloc allocates a string containing the same chars as the arg */
-
- # define WALLOCINITSIZE 1000
-
- static char wtable[WALLOCINITSIZE];
- int wtop = 0;
-
- char *walloc(val)
- char *val;
- { char *p;
- int size;
-
- size = 1 + strlen(val);
- if ((size < 40) && ((wtop + size) < WALLOCINITSIZE)) {
- p = &wtable[wtop];
- wtop += size;
- }
- else {
- p = o_alloc((unsigned) size);
- ca_wal++;
- }
- strcpy(p, val);
- return(p);
- }
-
- /*---------------------------------------*/
- extern class *ArrayedCollection;
- extern object *o_acollection;
-
- static mstruct *fr_string = 0;
-
- # define STRINITSIZE 50
-
- static string st_init_table[STRINITSIZE];
-
- str_init() {
- string *p;
- mstruct *new;
- int i;
-
- for (p = st_init_table, i = 0; i < STRINITSIZE; i++, p++) {
- new = (mstruct *) p;
- new->mlink = fr_string;
- fr_string = new;
- }
- }
-
- extern int started;
- static new_rstr(new)
- string *new;
- {
- new->s_ref_count = 0;
- new->s_size = STRINGSIZE;
- if (! started)
- sassign(new->s_super_obj, o_acollection);
- else if (ArrayedCollection)
- sassign(new->s_super_obj, new_inst(ArrayedCollection));
- else
- new->s_super_obj = (object *) 0;
- }
-
- string *new_istr(text)
- char *text;
- { register string *new;
-
- if (fr_string) {
- new = (string *) fr_string;
- fr_string = fr_string->mlink;
- }
- else {
- ca_str++;
- new = structalloc(string);
- }
-
- new->s_value = text;
- new_rstr(new);
- return(new);
- }
-
- # define STRLISTMAX 100
-
- mstruct *frl_str[STRLISTMAX];
-
- object *new_str(text)
- char *text;
- { int size;
- string *new;
-
- size = 1 + strlen(text);
- if ((size < STRLISTMAX) && frl_str[size]) {
- new = (string *) frl_str[size];
- frl_str[size] = frl_str[size]->mlink;
- strcpy(new->s_value, text);
- new_rstr(new);
- }
- else {
- new = new_istr(walloc(text));
- }
- return((object *) new);
- }
-
- free_string(s)
- string *s;
- { int size;
-
- if (s->s_super_obj)
- obj_dec(s->s_super_obj);
- size = 1 + strlen(s->s_value);
- if (size < STRLISTMAX) {
- ((mstruct *)s)->mlink = frl_str[size];
- frl_str[size] = (mstruct *) s;
- }
- else {
- ((mstruct *)s)->mlink = fr_string;
- fr_string = (mstruct *) s;
- }
- }
- End
- echo unbundling byte.c 1>&2
- cat >byte.c <<'End'
- /*
- Little Smalltalk
-
- bytearray manipulation.
- bytearrays are used almost entirely for storing bytecodes.
-
- timothy a. budd, 11/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
-
- # include <stdio.h>
- # include "object.h"
- # include "byte.h"
-
- /*
- bytearrays of less than MAXBSAVE are kept on a free list
- */
-
- static mstruct *fr_bytearray[MAXBSAVE]; /* better be initialized to zero ! */
-
- /*
- in order to avoid a large number of small mallocs, a table is used
- for the first new bytearrays. After the table becomes full,
- malloc is used to get more space.
- table should be large enough for the standard prelude, at least
- */
-
- static uchar btable[MAXBTABSIZE];
- int btabletop = 0;
-
- /*
- for the same reason, a number of bytearray bases are statically
- allocated and kept on a free list
- */
-
- int ca_barray = 0;
- static mstruct *fr_bybase = 0;
-
- static bytearray by_init[MAXBYINIT];
-
- byte_init()
- { int i;
- bytearray *p;
- mstruct *new;
-
- p = by_init;
- for (i = 0; i < MAXBYINIT; i++) {
- new = (mstruct *) p;
- new->mlink = fr_bybase;
- fr_bybase = new;
- p++;
- }
- }
-
- object *new_bytearray(values, size)
- uchar *values;
- int size;
- { bytearray *new;
- uchar *p, *q;
-
- if (size < MAXBSAVE && fr_bytearray[size]) {
- new = (bytearray *) fr_bytearray[size];
- fr_bytearray[size] = fr_bytearray[size]->mlink;
- }
- else {
- if (fr_bybase) {
- new = (bytearray *) fr_bybase;
- fr_bybase = fr_bybase->mlink;
- }
- else {
- new = structalloc(bytearray);
- ca_barray++;
- }
- if ((btabletop + size) < MAXBTABSIZE) {
- new->a_bytes = &btable[btabletop];
- btabletop += size;
- }
- else {
- new->a_bytes = (uchar *) o_alloc((unsigned) size);
- }
- }
- new->a_ref_count = 0;
- new->a_size = BYTEARRAYSIZE;
- new->a_bsize = size;
- for (p = new->a_bytes, q = values; size; size--) {
- *p++ = *q++;
- }
- return((object *) new);
- }
-
- free_bytearray(obj)
- bytearray *obj;
- { int size;
-
- if (! is_bytearray(obj))
- cant_happen(8);
- size = obj->a_bsize;
- if (size < MAXBSAVE) {
- ((mstruct *) obj)->mlink = fr_bytearray[size];
- fr_bytearray[size] = ((mstruct *) obj);
- }
- }
- End
- echo unbundling array.c 1>&2
- cat >array.c <<'End'
- /*
- Little Smalltalk
- Array creation
-
- timothy a. budd 10/84
-
- builds a new instance of class array.
- called mostly by the driver to construct array constants.
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
-
- class *Array = (class *) 0;
- class *ArrayedCollection = (class *) 0;
-
- extern object *o_nil, *o_empty, *o_acollection;
- extern int started; /* gets set after reading std prelude */
-
- /* new_iarray - internal form of new array */
- object *new_iarray(size)
- int size;
- { object *new;
-
- if (size < 0) cant_happen(2);
- new = new_obj(Array, size, 0);
- if (! started) {
- sassign(new->super_obj, o_acollection);
- }
- else if (ArrayedCollection)
- sassign(new->super_obj, new_inst(ArrayedCollection));
- return(new);
- }
-
- /* new_array - create a new array */
- object *new_array(size, initial)
- int size, initial;
- { int i;
- object *new;
-
- if (size == 0) return(o_empty);
- new = new_iarray(size);
- if (initial) {
- for (i = 0; i < size; i++)
- sassign(new->inst_var[ i ], o_nil);
- }
- return(new);
- }
- End
- echo unbundling file.c 1>&2
- cat >file.c <<'End'
- /*
- Little Smalltalk
-
- programs used by class File
- timothy a. budd 11/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "file.h"
- # include "string.h"
- # include "number.h"
- # include "primitive.h"
-
- static mstruct *fr_file = 0; /* free file list */
-
- object *new_file()
- { struct file_struct *new;
-
- if (fr_file) {
- new = (struct file_struct *) fr_file;
- fr_file = fr_file->mlink;
- }
- else {
- new = structalloc(struct file_struct);
- }
-
- new->l_size = FILESIZE;
- new->l_ref_count = 0;
- new->file_mode = STRMODE;
- new->fp = NULL;
- return((object *) new);
- }
-
- free_file(phil)
- struct file_struct *phil;
- {
- if (! is_file(phil))
- cant_happen(8);
- if (phil->fp != NULL)
- fclose(phil->fp);
- ((mstruct *) phil)->mlink = fr_file;
- fr_file = (mstruct *) phil;
- }
-
- file_err(message)
- char *message;
- { object *errp;
- char buffer[150];
-
- sprintf(buffer,"File: %s", message);
- sassign(errp, new_str(buffer));
- primitive(ERRPRINT, 1, &errp);
- obj_dec(errp);
- }
-
- file_open(phil, name, type)
- struct file_struct *phil;
- char *name, *type;
- { char buffer[100];
-
- if (phil->fp != NULL)
- fclose(phil->fp);
- phil->fp = fopen(name, type);
- if (phil->fp == NULL) {
- sprintf(buffer,"can't open: %s\n", name);
- file_err(buffer);
- }
- }
-
- # define BUFLENGTH 250
-
- object *file_read(phil)
- struct file_struct *phil;
- { object *new;
- int c;
- char buffer[BUFLENGTH], *p;
-
- if (phil->fp == NULL) {
- file_err("attempt to read from unopened file");
- return(o_nil);
- }
- switch(phil->file_mode) {
- case CHARMODE:
- if (EOF == (c = fgetc(phil->fp)))
- new = o_nil;
- else
- new = new_char(c);
- break;
- case STRMODE:
- if (NULL == fgets(buffer, BUFLENGTH, phil->fp))
- new = o_nil;
- else {
- p = &buffer[strlen(buffer) - 1];
- if (*p == '\n') *p = '\0';
- new = new_str(buffer);
- }
- break;
- case INTMODE:
- if (EOF == (c = getw(phil->fp)))
- new = o_nil;
- else
- new = new_int(c);
- break;
- default:
- file_err("unknown mode");
- new = o_nil;
- }
- return(new);
- }
-
- file_write(phil, obj)
- struct file_struct *phil;
- object *obj;
- {
- if (phil->fp == NULL) {
- file_err("attempt to write to unopened file");
- return;
- }
- switch(phil->file_mode) {
- case CHARMODE:
- if (! is_character(obj)) goto modeerr;
- fputc(int_value(obj), phil->fp);
- break;
- case STRMODE:
- if (! is_string(obj)) goto modeerr;
- fputs(string_value(obj), phil->fp);
- fputc('\n', phil->fp);
- break;
- case INTMODE:
- if (! is_integer(obj)) goto modeerr;
- putw(int_value(obj), phil->fp);
- break;
- }
- return;
- modeerr:
- file_err("attempt to write object of wrong type for mode");
- }
- End
- echo unbundling primitive.c 1>&2
- cat >primitive.c <<'End'
- /*
- Little Smalltalk
-
- Primitive manager
- timothy a. budd
- 10/84
-
- hashcode code written by Robert McConeghy
- (who also wrote classes Dictionary, et al).
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
-
- # include "object.h"
-
- # ifdef CURSES
- # include <curses.h>
- # endif
-
- # include <stdio.h>
- # include <ctype.h>
- # include <math.h>
- # include <errno.h>
- # include "drive.h"
- # include "interp.h"
- # include "process.h"
- # include "block.h"
- # include "string.h"
- # include "symbol.h"
- # include "number.h"
- # include "file.h"
- # include "byte.h"
- # include "primitive.h"
-
- extern int errno;
- extern int prntcmd;
- extern double modf();
- extern long time();
- extern object *lookup_class();
- extern process *runningProcess;
- extern int responds_to(), generality();
- extern class *mk_class();
- extern object *o_object, *o_true, *o_false, *o_nil, *o_number, *o_magnitude;
-
- object *primitive(primnumber, numargs, args)
- int primnumber, numargs;
- object **args;
- { object *resultobj;
- object *leftarg, *rightarg, *fnd_class(), *fnd_super();
- int leftint, rightint, i, j;
- double leftfloat, rightfloat;
- long clock;
- char *leftp, *rightp, *errp;
- class *aClass;
- bytearray *byarray;
- struct file_struct *phil;
- int opnumber = primnumber % 10;
- char strbuffer[300], tempname[100];
-
- errno = 0;
- /* first do argument type checking */
- switch(i = (primnumber / 10)) {
- case 0: /* misc operations */
- if (opnumber <= 5 && numargs != 1) goto argcerror;
- leftarg = args[0];
- break;
-
- case 1: /* integer operations */
- case 2:
- if (numargs != 2) goto argcerror;
- rightarg = args[1];
- if (! is_integer(rightarg)) goto argterror;
- rightint = int_value(rightarg);
- case 3:
- if (i == 3 && opnumber && numargs != 1)
- goto argcerror;
- leftarg = args[0];
- if (! is_integer(leftarg)) goto argterror;
- leftint = int_value(leftarg);
- break;
-
- case 4: /* character operations */
- if (numargs != 2) goto argcerror;
- rightarg = args[1];
- if (! is_character(rightarg)) goto argterror;
- rightint = int_value(rightarg);
- case 5:
- if (i == 5 && numargs != 1) goto argcerror;
- leftarg = args[0];
- if (! is_character(leftarg)) goto argterror;
- leftint = int_value(leftarg);
- break;
-
- case 6: /* floating point operations */
- if (numargs != 2) goto argcerror;
- rightarg = args[1];
- if (! is_float(rightarg)) goto argterror;
- rightfloat = float_value(rightarg);
- case 7:
- if (i == 7 && numargs != 1) goto argcerror;
- case 8:
- if (i == 8 && opnumber < 8 && numargs != 1)
- goto argcerror;
- leftarg = args[0];
- if (! is_float(leftarg)) goto argterror;
- leftfloat = float_value(leftarg);
- break;
-
- case 9: /* symbol operations */
- leftarg = args[0];
- if (! is_symbol(leftarg)) goto argterror;
- leftp = symbol_value(leftarg);
- break;
-
- case 10: /* string operations */
- if (numargs < 1) goto argcerror;
- leftarg = args[0];
- if (! is_string(leftarg)) goto argterror;
- leftp = string_value(leftarg);
- if (opnumber && opnumber <= 3) {
- if (numargs != 2) goto argcerror;
- rightarg = args[1];
- if (! is_string(rightarg)) goto argterror;
- rightp = string_value(rightarg);
- }
- else if ((opnumber >= 4) && (opnumber <= 6)) {
- if (numargs < 2) goto argcerror;
- if (! is_integer(args[1])) goto argterror;
- i = int_value(args[1])-1;
- if ((i < 0) || (i >= strlen(leftp)))
- goto indexerror;
- }
- else if ((opnumber >= 7) && (numargs != 1))
- goto argcerror;
- break;
-
- case 11: /* misc operations */
- if ((opnumber == 1) || (opnumber == 2)) {
- if (is_bltin(args[0])) goto argterror;
- if (numargs < 2) goto argcerror;
- if (! is_integer(args[1])) goto argterror;
- i = int_value(args[1]);
- if (i < 1 || i > args[0]->size)
- goto indexerror;
- }
- else if ((opnumber >= 4) && (opnumber <= 6)) {
- if (numargs != 1) goto argcerror;
- if (! is_integer(args[0])) goto argterror;
- i = int_value(args[0]);
- if (i < 0) goto indexerror;
- }
- else if (opnumber >= 7) {
- if (numargs < 1) goto argcerror;
- if (! is_bytearray(args[0])) goto argterror;
- byarray = (bytearray *) args[0];
- if (opnumber >= 8) {
- if (numargs < 2) goto argcerror;
- if (! is_integer(args[1]))
- goto argterror;
- i = int_value(args[1]) - 1;
- if (i < 0 || i >= byarray->a_bsize)
- goto indexerror;
- }
- }
- break;
-
- case 12: /* string i/o operations */
- if (opnumber < 6) {
- if (numargs < 1) goto argcerror;
- leftarg = args[0];
- if (! is_string(leftarg)) goto argterror;
- leftp = string_value(leftarg);
- }
- break;
-
- case 13: /* operations on file */
- if (numargs < 1) goto argcerror;
- if (! is_file(args[0])) goto argterror;
- phil = (struct file_struct *) args[0];
- if (opnumber && (phil->fp == (FILE *) NULL)) {
- errp = "file must be open for operation";
- goto return_error;
- }
- break;
-
- case 15: /* operations on classes */
- if (opnumber < 3 && numargs != 1) goto argcerror;
- if (! is_class(args[0])) goto argterror;
- aClass = (class *) args[0];
- break;
-
- # ifdef PLOT3
- case 17: /* plot(3) interface */
- if (opnumber && opnumber <= 3) {
- if (numargs != 2) goto argcerror;
- if ((! is_integer(args[0])) ||
- (! is_integer(args[1])))
- goto argterror;
- leftint = int_value(args[0]);
- rightint = int_value(args[1]);
- }
- else if ((opnumber == 6) || (opnumber == 7)) {
- if (numargs != 4) goto argcerror;
- for (i = 0; i < 4; i++)
- if (! is_integer(args[i]))
- goto argterror;
- leftint = int_value(args[0]);
- rightint = int_value(args[1]);
- i = int_value(args[2]);
- j = int_value(args[3]);
- }
- else if (opnumber >= 8) {
- if (numargs != 1) goto argcerror;
- if (! is_string(args[0])) goto argterror;
- leftp = string_value(args[0]);
- }
- break;
- # endif
- }
-
-
- /* now do operation */
- switch(primnumber) {
-
- case 1: /* class of object */
- resultobj = fnd_class(args[0]);
- if (resultobj) goto return_obj;
- else goto return_nil;
-
- case 2: /* get super_object */
- resultobj = fnd_super(args[0]);
- if (resultobj) goto return_obj;
- else goto return_nil;
-
- case 3: /* see if class responds to new */
- leftint = 0;
- if (! is_class(args[0])) goto return_boolean;
- leftint = responds_to("new", (class *) args[0]);
- goto return_boolean;
-
- case 4: /* compute size of object */
- leftint = args[0]->size;
- goto return_integer;
-
- case 5: /* return hashnum of object */
- if (is_integer(leftarg))
- leftint = int_value(leftarg);
- else if (is_character(leftarg))
- leftint = int_value(leftarg);
- else if (is_symbol(leftarg))
- leftint = (int) symbol_value(leftarg);
- else if (is_string(leftarg)) {
- leftp = string_value(leftarg);
- leftint = 0;
- for(i = 0; *leftp != 0; leftp++){
- leftint += *leftp;
- i++;
- if(i > 5)
- break;
- }
- }
- else /* for all other objects return address */
- leftint = (int) &leftarg;
- if (leftint < 0)
- leftint = -leftint;
- goto return_integer;
-
- case 6: /* built in object type testing */
- if (numargs != 2) goto argcerror;
- leftint = 0;
- if (is_bltin(args[0]) == is_bltin(args[1]))
- if (is_bltin(args[0]))
- leftint = (args[0]->size == args[1]->size);
- else leftint = (args[0]->class == args[1]->class);
- goto return_boolean;
-
- case 7: /* object equality testing */
- if (numargs != 2) goto argcerror;
- leftint = (args[0] == args[1]);
- goto return_boolean;
-
- case 8: /* toggle debugging flag */
- if (numargs == 0) {
- debug = 1 - debug;
- goto return_nil;
- }
- if (numargs != 2) goto argcerror;
- if (! is_integer(args[0])) goto argterror;
- if (! is_integer(args[1])) goto argterror;
- leftint = int_value(args[0]);
- rightint = int_value(args[1]);
- switch(leftint) {
- case 1: prntcmd = rightint; break;
- case 2: debug = rightint; break;
- }
- goto return_nil;
-
- case 9: /* numerical generality comparison */
- if (numargs != 2) goto argcerror;
- leftint =
- (generality(args[0]) > generality(args[1]));
- goto return_boolean;
-
- case 10: /* integer addition */
- leftint += rightint;
- goto return_integer;
-
- case 11: /* integer subtraction */
- leftint -= rightint;
- goto return_integer;
-
- case 12: case 42:
- leftint = (leftint < rightint);
- goto return_boolean;
-
- case 13: case 43:
- leftint = (leftint > rightint);
- goto return_boolean;
-
- case 14: case 44:
- leftint = (leftint <= rightint);
- goto return_boolean;
-
- case 15: case 45:
- leftint = (leftint >= rightint);
- goto return_boolean;
-
- case 16: case 46:
- leftint = (leftint == rightint);
- goto return_boolean;
-
- case 17: case 47:
- leftint = (leftint != rightint);
- goto return_boolean;
-
- case 18:
- leftint *= rightint;
- goto return_integer;
-
- case 19: /* // integer */
- if (rightint == 0) goto numerror;
- i = leftint / rightint;
- if ((leftint < 0) && (leftint % rightint))
- i -= 1;
- leftint = i;
- goto return_integer;
-
- case 20: /* gcd of two integers */
- if (leftint == 0 || rightint == 0) goto numerror;
- if (leftint < 0) leftint = -leftint;
- if (rightint < 0) rightint = -rightint;
- if (leftint > rightint)
- {i = leftint; leftint = rightint; rightint = i;}
- while (i = rightint % leftint)
- {rightint = leftint; leftint = i;}
- goto return_integer;
-
- case 21: /* bitAt: */
- leftint = (leftint & (1 << rightint)) ? 1 : 0;
- goto return_integer;
-
- case 22: /* logical bit-or */
- leftint |= rightint;
- goto return_integer;
-
- case 23: /* logical bit-and */
- leftint &= rightint;
- goto return_integer;
-
- case 24: /* logical bit-exclusive or */
- leftint ^= rightint;
- goto return_integer;
-
- case 25: /* bit shift */
- if (rightint < 0)
- leftint >>= - rightint;
- else
- leftint <<= rightint;
- goto return_integer;
-
- case 26: /* integer radix */
- if (rightint < 2 || rightint > 36) goto numerror;
- prnt_radix(leftint, rightint, strbuffer);
- goto return_string;
-
- case 28:
- if (rightint == 0) goto numerror;
- leftint /= rightint;
- goto return_integer;
-
- case 29:
- if (rightint == 0) goto numerror;
- leftint %= rightint;
- goto return_integer;
-
- case 30: /* doPrimitive:withArguments: */
- if (numargs != 2) goto argcerror;
- resultobj = primitive(leftint, args[1]->size,
- &args[1]->inst_var[0]);
- goto return_obj;
-
- case 32: /* convert random int into random float */
- leftfloat = ((double) ((leftint/10) % 1000)) / 1000.0;
- goto return_float;
-
- case 33: /* bit inverse */
- leftint ^= -1;
- goto return_integer;
-
- case 34: /* highBit */
- rightint = leftint;
- for (leftint = 32; leftint >= 0; leftint--)
- if (rightint & (1 << leftint))
- goto return_integer;
- goto return_nil;
-
- case 35: /* random number */
- srand(leftint);
- leftint = rand();
- goto return_integer;
-
- case 36: /* convert integer to character */
- goto return_character;
-
- case 37: /* convert integer to string */
- sprintf(strbuffer,"%d", leftint);
- goto return_string;
-
- case 38: /* factorial */
- if (leftint < 0) goto numerror;
- if (leftint < FACTMAX) {
- for (i = 1; leftint; leftint--)
- i *= leftint;
- leftint = i;
- goto return_integer;
- }
- # ifndef GAMMA
- /* gamma not supported, use float multiply */
- leftfloat = 1.0;
- if (leftint < 30) {
- for (i = 1; leftint; leftint--)
- leftfloat *= leftint;
- }
- goto return_float;
- # endif
- # ifdef GAMMA
- /* compute gamma */
- leftfloat = (double) (leftint + 1);
- sassign(leftarg, new_float(leftfloat));
- resultobj = primitive(GAMMAFUN, 1, &leftarg);
- obj_dec(leftarg);
- goto return_obj;
- # endif
-
- case 39: /* convert integer to float */
- leftfloat = (double) leftint;
- goto return_float;
-
- case 50: /* digitValue */
- if (isdigit(leftint))
- leftint -= '0';
- else if (isupper(leftint)) {
- leftint -= 'A';
- leftint += 10;
- }
- else goto return_nil;
- goto return_integer;
-
- case 51:
- if (isupper(leftint)) leftint += 'a' - 'A';
- leftint = (leftint == 'a') || (leftint == 'e') ||
- (leftint == 'i') || (leftint == 'o') ||
- (leftint == 'u');
- goto return_boolean;
-
- case 52:
- leftint = isalpha(leftint);
- goto return_boolean;
-
- case 53:
- leftint = islower(leftint);
- goto return_boolean;
-
- case 54:
- leftint = isupper(leftint);
- goto return_boolean;
-
- case 55:
- leftint = isspace(leftint);
- goto return_boolean;
-
- case 56:
- leftint = isalnum(leftint);
- goto return_boolean;
-
- case 57:
- if (isupper(leftint)) leftint += 'a' - 'A';
- else if (islower(leftint)) leftint += 'A' - 'a';
- goto return_character;
-
- case 58: /* convert character to string */
- sprintf(strbuffer,"%c", leftint);
- goto return_string;
-
- case 59: /* convert character to integer */
- goto return_integer;
-
- case 60: /* floating point addition */
- leftfloat += rightfloat;
- goto return_float;
-
- case 61: /* floating point subtraction */
- leftfloat -= rightfloat;
- goto return_float;
-
- case 62:
- leftint = (leftfloat < rightfloat);
- goto return_boolean;
-
- case 63:
- leftint = (leftfloat > rightfloat);
- goto return_boolean;
-
- case 64:
- leftint = (leftfloat <= rightfloat);
- goto return_boolean;
-
- case 65:
- leftint = (leftfloat >= rightfloat);
- goto return_boolean;
-
- case 66:
- leftint = (leftfloat == rightfloat);
- goto return_boolean;
-
- case 67:
- leftint = (leftfloat != rightfloat);
- goto return_boolean;
-
- case 68:
- leftfloat *= rightfloat;
- goto return_float;
-
- case 69:
- if (rightfloat == 0) goto numerror;
- leftfloat /= rightfloat;
- goto return_float;
-
- case 70:
- leftfloat = log(leftfloat);
- goto float_check;
-
- case 71:
- if (leftfloat < 0) goto numerror;
- leftfloat = sqrt(leftfloat);
- goto float_check;
-
- case 72:
- leftint = (int) floor(leftfloat);
- goto return_integer;
-
- case 73: /* ceiling */
- leftint = (int) ceil(leftfloat);
- goto return_integer;
-
- case 75: /* integer part */
- leftfloat = modf(leftfloat, &rightfloat);
- leftint = (int) rightfloat;
- goto return_integer;
-
- case 76: /* fractional part */
- leftfloat = modf(leftfloat, &rightfloat);
- goto return_float;
-
- case 77: /* gamma function */
- # ifdef GAMMA
- leftfloat = gamma(leftfloat);
- if (leftfloat > 88.0) goto numerror;
- leftfloat = exp(leftfloat);
- goto float_check;
- # endif
- # ifndef GAMMA
- errp = "gamma function";
- goto not_implemented;
- # endif
-
- case 78:
- sprintf(strbuffer,"%g", leftfloat);
- goto return_string;
-
- case 79:
- leftfloat = exp(leftfloat);
- goto return_float;
-
- case 80: /* normalize radian value */
- # define TWOPI (double) 6.2831853072
- rightfloat =
- floor(((leftfloat < 0) ? -leftfloat:leftfloat) / TWOPI);
- if (leftfloat < 0)
- leftfloat += (1 + rightfloat) * TWOPI;
- else
- leftfloat -= rightfloat * TWOPI;
- goto return_float;
-
- case 81:
- leftfloat = sin(leftfloat);
- goto float_check;
-
- case 82:
- leftfloat = cos(leftfloat);
- goto float_check;
-
- case 84:
- leftfloat = asin(leftfloat);
- goto float_check;
-
- case 85:
- leftfloat = acos(leftfloat);
- goto float_check;
-
- case 86:
- leftfloat = atan(leftfloat);
- goto float_check;
-
- case 88:
- if (numargs != 2) goto argcerror;
- if (! is_float(args[1])) goto argterror;
- leftfloat = pow(leftfloat, float_value(args[1]));
- goto float_check;
-
- case 89: /* floating point radix */
- if (numargs != 2) goto argcerror;
- if (! is_integer(args[1])) goto argterror;
- i = int_value(args[1]); /* base */
- if (i < 2 || i > 36) goto numerror;
- fprnt_radix(leftfloat, i, strbuffer);
- goto return_string;
-
- case 91: /* symbol comparison */
- if (numargs != 2) goto argcerror;
- if (! is_symbol(args[1])) goto argterror;
- leftint = (leftp == symbol_value(args[1]));
- goto return_boolean;
-
- case 92: /* symbol printString */
- sprintf(strbuffer, "#%s", leftp);
- goto return_string;
-
- case 93: /* symbol asString */
- sprintf(strbuffer, "%s", leftp);
- goto return_string;
-
- case 94: /* symbol print ( with tabs) */
- if (numargs == 2) {
- if (! is_integer(args[1])) goto argterror;
- for (i = int_value(args[1]); i >= 0; i--)
- putchar('\t');
- }
- printf("%s\n", leftp);
- # ifdef FLUSHREQ
- fflush(stdout);
- # endif
- goto return_nil;
-
- case 96:
- goto return_nil;
-
- case 97: /* make a new class (generated by parser)*/
- if (numargs != 8) goto argcerror;
- if (! is_symbol(args[1])) goto argterror;
- if (! is_symbol(args[2])) goto argterror;
- if (! is_integer(args[6])) goto argterror;
- if (! is_integer(args[7])) goto argterror;
- resultobj = (object *) mk_class(leftp, args);
- goto return_obj;
-
- case 98: /* install class in dictionary */
- if (numargs != 2) goto argcerror;
- if (! is_class(args[1])) goto argterror;
- enter_class(leftp, args[1]);
- goto return_nil;
-
- case 99: /* find a class in class dictionary */
- if (numargs != 1) goto argcerror;
- resultobj = lookup_class(leftp);
- if (resultobj == (object *) 0) {
- sprintf(strbuffer,"cannot find class %s",
- leftp);
- sassign(resultobj, new_str(strbuffer));
- primitive(ERRPRINT, 1, &resultobj);
- obj_dec(resultobj);
- resultobj = lookup_class("Object");
- if (! resultobj) cant_happen(7);
- }
- goto return_obj;
-
- case 100: /* string length */
- leftint = strlen(leftp);
- goto return_integer;
-
- case 101: /* string compare, case dependent */
- leftint = strcmp(leftp, rightp);
- goto return_integer;
-
- case 102: /* string compare, case independent */
- leftint = 1;
- while (*leftp || *rightp) {
- i = *leftp++;
- j = *rightp++;
- if (i >= 'A' && i <= 'Z')
- i = i - 'A' + 'a';
- if (j >= 'A' && j <= 'Z')
- j = j - 'A' + 'a';
- if (i != j) {leftint = 0; break;}
- }
- goto return_boolean;
-
- case 103: /* string catenation */
- for (i = leftint = 0; i < numargs; i++) {
- if (! is_string(args[i])) goto argterror;
- leftint += strlen(string_value(args[i]));
- }
- errp = (char *) o_alloc((unsigned) (1 + leftint));
- *errp = '\0';
- for (i = 0; i < numargs; i++)
- strcat(errp, string_value(args[i]));
- resultobj = (object *) new_istr(errp);
- goto return_obj;
-
- case 104: /* string at: */
- if (numargs != 2) goto argcerror;
- leftint = leftp[i];
- goto return_character;
-
- case 105: /* string at: put: */
- if (numargs != 3) goto argcerror;
- if (! is_character(args[2])) goto argterror;
- leftp[i] = int_value(args[2]);
- goto return_nil;
-
- case 106: /* copyFrom: length: */
- if (numargs != 3) goto argcerror;
- if (! is_integer(args[2])) goto argterror;
- j = int_value(args[2]);
- if (j < 0) goto indexerror;
- for (rightp = strbuffer; j; j--, i++)
- *rightp++ = leftp[i];
- *rightp = '\0';
- goto return_string;
-
- case 107: /* string copy */
- resultobj = new_str(leftp);
- goto return_obj;
-
- case 108: /* string asSymbol */
- resultobj = new_sym(leftp);
- goto return_obj;
-
- case 109: /* string printString */
- sprintf(strbuffer,"\'%s\'", leftp);
- goto return_string;
-
- case 110: /* new untyped object */
- if (numargs != 1) goto argcerror;
- if (! is_integer(args[0])) goto argterror;
- leftint = int_value(args[0]);
- if (leftint < 0) goto numerror;
- resultobj = new_obj((class *) 0, leftint, 1);
- goto return_obj;
-
- case 111: /* object at: */
- if (numargs != 2) goto argcerror;
- resultobj = args[0]->inst_var[ i - 1 ];
- goto return_obj;
-
- case 112: /* object at:put: */
- if (numargs != 3) goto argcerror;
- assign(args[0]->inst_var[i - 1], args[2]);
- goto return_nil;
-
- case 113: /* object grow */
- leftarg = args[0];
- rightarg = args[1];
- if (is_bltin(leftarg)) goto argterror;
- resultobj = new_obj(leftarg->class,
- leftarg->size+1, 0);
- if (leftarg->super_obj)
- sassign(resultobj->super_obj,
- leftarg->super_obj);
- for (i = 0; i < leftarg->size; i++)
- sassign(resultobj->inst_var[i], leftarg->inst_var[i]);
- sassign(resultobj->inst_var[i], rightarg);
- goto return_obj;
-
-
- case 114: /* new array */
- resultobj = new_array(i, 1);
- goto return_obj;
-
- case 115: /* new string */
- for (j = 0; j < i; j++)
- strbuffer[j] = ' ';
- strbuffer[j] = '\0';
- goto return_string;
-
- case 116: /* bytearray new */
- /* initialize with random garbage */
- resultobj = new_bytearray(strbuffer, i);
- goto return_obj;
-
- case 117: /* bytearray size */
- if (numargs != 1) goto argcerror;
- leftint = byarray->a_bsize;
- goto return_integer;
-
- case 118: /* bytearray at: */
- if (numargs != 2) goto argcerror;
- leftint = uctoi(byarray->a_bytes[i]);
- goto return_integer;
-
- case 119: /* bytearray at:put: */
- if (numargs != 3) goto argcerror;
- if (! int_value(args[2])) goto argterror;
- byarray->a_bytes[i] = itouc(int_value(args[2]));
- goto return_nil;
-
- case 120: /* print, no return */
- printf("%s", leftp);
- # ifdef FLUSHREQ
- fflush(stdout);
- # endif
- goto return_nil;
-
- case 121: /* print, with return */
- printf("%s\n", leftp);
- # ifdef FLUSHREQ
- fflush(stdout);
- # endif
- goto return_nil;
-
- case 122: /* format for error printing */
- aClass = (class *) fnd_class(args[1]);
- sprintf(strbuffer,"%s: %s",
- symbol_value(aClass->class_name), leftp);
- leftp = strbuffer;
-
- case 123: /* print on error output */
- fprintf(stderr,"%s\n", leftp);
- # ifdef FLUSHREQ
- fflush(stderr);
- # endif
- goto return_nil;
-
- case 125: /* unix system call */
- # ifndef NOSYSTEM
- leftint = system(leftp);
- goto return_integer;
- # endif
- # ifdef NOSYSTEM
- errp = "system()";
- goto not_implemented;
- # endif
-
- case 126: /* printAt: */
- # ifndef CURSES
- errp = "curses graphics package not available";
- goto return_error;
- # endif
- # ifdef CURSES
- if (numargs != 3) goto argcerror;
- if ((! is_string(args[0])) ||
- (! is_integer(args[1])) ||
- (! is_integer(args[2])) ) goto argterror;
- move(int_value(args[1]), int_value(args[2]));
- addstr(string_value(args[0]));
- refresh();
- move(0, LINES-1);
- goto return_nil;
- # endif
-
- case 127: /* block return */
- errp = "block return without surrounding context";
- goto return_error;
-
- case 128: /* reference count error */
- if (numargs != 1) goto argcerror;
- sprintf(strbuffer,"object %d reference count %d",
- args[0], args[0]->ref_count);
- errp = strbuffer;
- goto return_error;
-
- case 129: /* does not respond error */
- if (numargs != 2) goto argcerror;
- if (! is_symbol(args[1])) goto argterror;
- fprintf(stderr,"respond error: %s\n",
- symbol_value(args[1]));
- aClass = (class *) fnd_class(args[0]);
- if (! is_class(aClass)) goto argterror;
- sprintf(strbuffer,"%s: does not respond to %s",
- symbol_value(aClass->class_name),
- symbol_value(args[1]));
- errp = strbuffer;
- goto return_error;
-
- case 130: /* file open */
- if (numargs != 3) goto argcerror;
- if (! is_string(args[1])) goto argterror;
- if (! is_string(args[2])) goto argterror;
- file_open(phil,
- string_value(args[1]), string_value(args[2]));
- goto return_nil;
-
- case 131: /* file read */
- if (numargs != 1) goto argcerror;
- resultobj = file_read(phil);
- goto return_obj;
-
- case 132: /* file write */
- if (numargs != 2) goto argcerror;
- file_write(phil, args[1]);
- goto return_nil;
-
- case 133: /* set file mode */
- if (numargs != 2) goto argcerror;
- if (! is_integer(args[1])) goto argterror;
- phil->file_mode = int_value(args[1]);
- goto return_nil;
-
- case 134: /* compute file size */
- fseek(phil->fp, (long) 0, 2);
- leftint = (int) ftell(phil->fp);
- goto return_integer;
-
- case 135: /* set file position */
- if (numargs != 2) goto argcerror;
- if (! is_integer(args[1])) goto argterror;
- leftint = fseek(phil->fp, (long) int_value(args[1]), 0);
- goto return_integer;
-
- case 136: /* find current position */
- if (numargs != 1) goto argcerror;
- leftint = (int) ftell(phil->fp);
- goto return_integer;
-
- case 140:
- errp = "block execute should be trapped by interp";
- goto return_error;
-
- case 141: /* newProcess (withArguments:) */
- if (numargs < 1) goto argcerror;
- if (! is_block(args[0])) goto argterror;
- if (numargs == 1)
- resultobj = (object *)
- block_execute((interpreter *) 0,
- (block *) args[0], 0, args);
- else if (numargs == 2)
- resultobj = (object *)
- block_execute((interpreter *) 0,
- (block *) args[0], args[1]->size,
- &(args[1]->inst_var[0]));
- else goto argcerror;
- if (((object *) 0) == resultobj) goto return_nil;
- resultobj = (object *) cr_process(resultobj);
- goto return_obj;
-
- case 142: /* terminate a process */
- if (numargs != 1) goto argcerror;
- if (! is_process(args[0])) goto argterror;
- terminate_process( (process *) args[0]);
- goto return_nil;
-
- case 143: /* perform:withArguments: */
- errp = "perform should be trapped by interpreter";
- goto return_error;
-
- case 145: /* set the state of a process */
- if (numargs != 2) goto argcerror;
- if (! is_process(args[0])) goto argterror;
- if (! is_integer(args[1])) goto argterror;
- leftint = int_value(args[1]);
- switch (leftint) {
- case 0: leftint = READY;
- break;
- case 1: leftint = SUSPENDED;
- break;
- case 2: leftint = BLOCKED;
- break;
- case 3: leftint = UNBLOCKED;
- break;
- default: errp = "invalid state for process";
- goto return_error;
-
- }
- set_state((process *) args[0], leftint);
- goto return_integer;
-
- case 146: /* return the state of a process */
- if (numargs != 1) goto argcerror;
- if (! is_process(args[0])) goto argterror;
- leftint = set_state((process *) args[0], CUR_STATE);
- goto return_integer;
-
- case 148: /* begin atomic action */
- if (numargs != 0) goto argcerror;
- atomcnt++;
- goto return_nil;
-
- case 149: /* end atomic action */
- if (numargs != 0) goto argcerror;
- if (atomcnt == 0) {
- errp = "end atomic attempted while not in atomic action";
- goto return_error;
- }
- atomcnt--;
- goto return_nil;
-
- case 150: /* class edit */
- leftp = symbol_value(aClass->file_name);
- if (! writeable(leftp)) {
- gettemp(tempname);
- sprintf(strbuffer,"cp %s %s", leftp, tempname);
- # ifndef NOSYSTEM
- system(strbuffer);
- # endif
- leftp = tempname;
- }
- if (! lexedit(leftp)) lexinclude(leftp);
- goto return_nil;
-
- case 151: /* superclass of a class */
- if (! aClass->super_class)
- goto return_nil;
- resultobj = (object *) aClass->super_class;
- if (! is_symbol(resultobj)) goto return_nil;
- resultobj = lookup_class(symbol_value(resultobj));
- if (! resultobj) goto return_nil;
- goto return_obj;
-
- case 152: /* class name */
- resultobj = aClass->class_name;
- leftp = symbol_value(resultobj);
- resultobj = new_str(leftp);
- goto return_obj;
-
- case 153: /* new */
- if (numargs != 2) goto argcerror;
- if (args[1] == o_nil)
- resultobj = new_inst(aClass);
- else
- resultobj = new_sinst(aClass, args[1]);
- goto return_obj;
-
- case 154: /* print message names list */
- prnt_messages(aClass);
- goto return_nil;
-
- case 155: /* respondsTo: aMessage */
- if (numargs != 2) goto argcerror;
- if (! is_symbol(args[1])) goto argterror;
- leftint = responds_to(symbol_value(args[1]), aClass);
- goto return_boolean;
-
- case 156: /* class view */
- # ifndef NOSYSTEM
- leftp = symbol_value(aClass->file_name);
- gettemp(tempname);
- sprintf(strbuffer,"cp %s %s", leftp, tempname);
- system(strbuffer);
- leftp = tempname;
- lexedit(leftp);
- goto return_nil;
- # endif
- # ifdef NOSYSTEM
- errp = "cannot view classes on this system";
- goto return_error;
- # endif
-
- case 157: /* class list */
- class_list(aClass, 0);
- goto return_nil;
-
-
- case 158: /* variables */
- resultobj = aClass->c_inst_vars;
- goto return_obj;
-
- case 160: /* current time */
- time(&clock);
- strcpy(strbuffer, ctime(&clock));
- goto return_string;
-
- case 161: /* time, measure in seconds */
- leftint = (int) time((long *) 0);
- goto return_integer;
-
- case 162: /* clear screen */
- # ifdef CURSES
- clear();
- move(0,0);
- refresh();
- # endif
- # ifdef PLOT3
- erase();
- # endif
- goto return_nil;
-
- case 163: /* getString */
- gets(strbuffer);
- goto return_string;
-
- case 164: /* string asInteger */
- if (! is_string(args[0])) goto argterror;
- leftint = atoi(string_value(args[0]));
- goto return_integer;
-
- case 165: /* string asFloat */
- if (! is_string(args[0])) goto argterror;
- leftfloat = atof(string_value(args[0]));
- goto return_float;
-
- # ifdef PLOT3
-
- /**************************
- warning - the calls on the plot(3) routines are very device
- specific, and will probably require changes to work on any one
- particular new device
- **********************************/
- case 170: /* clear */
- erase();
- goto return_nil;
-
- case 171: /* move(x,y) */
- move(leftint, rightint);
- goto return_nil;
-
- case 172: /* cont(x,y) (draw line) */
- cont(leftint, rightint);
- goto return_nil;
-
- case 173: /* point(x,y) (draw point) */
- point(leftint, rightint);
- goto return_nil;
-
- case 174: /* circle(x, y, r) */
- if (numargs != 3) goto argcerror;
- for (i = 0; i < 3; i++)
- if (! is_integer(args[i]))
- goto argterror;
- circle(int_value(args[0]), int_value(args[1]),
- int_value(args[2]));
- goto return_nil;
-
- case 175: /* arg(x, y, x0, y0, x1, y1) */
- if (numargs != 6) goto argcerror;
- for (i = 0; i < 6; i++)
- if (! is_integer(args[i])) goto argterror;
- arc(int_value(args[0]), int_value(args[1]),
- int_value(args[2]), int_value(args[3]),
- int_value(args[4]), int_value(args[5]));
- goto return_nil;
-
- case 176: /* space */
- space(leftint, rightint, i, j);
- goto return_nil;
-
- case 177: /* line */
- line(leftint, rightint, i, j);
- goto return_nil;
-
- case 178: /* label */
- label(leftp);
- goto return_nil;
-
- case 179: /* linemod */
- linemod(leftp);
- goto return_nil;
- # endif
-
- default: fprintf(stderr,"Primitive number %d not implemented\n",
- primnumber);
- goto return_nil;
- }
-
- /* return different types of objects */
-
- return_obj:
-
- return(resultobj);
-
- return_nil:
-
- return(o_nil);
-
- return_integer:
-
- return(new_int(leftint));
-
- return_character:
-
- return(new_char(leftint));
-
- return_boolean:
-
- return(leftint ? o_true : o_false);
-
- float_check:
-
- if (errno == ERANGE || errno == EDOM) goto numerror;
-
- return_float:
-
- return(new_float(leftfloat));
-
- return_string:
-
- return(new_str(strbuffer));
-
- /* error conditions */
-
- not_implemented:
- sprintf(strbuffer,"%s not implemented yet", errp);
- errp = strbuffer;
- goto return_error;
-
- argcerror:
- sprintf(strbuffer,"%d is wrong number of arguments for primitive %d",
- numargs, primnumber);
- errp = strbuffer;
- goto return_error;
-
- argterror:
- sprintf(strbuffer,"argument type not correct for primitive %d",
- primnumber);
- errp = strbuffer;
- goto return_error;
-
- numerror:
- errp = "numerical error in primitive";
- goto return_error;
-
- indexerror:
- errp = "primitive index error";
- goto return_error;
-
- return_error:
- sassign(resultobj, new_str(errp));
- primitive(ERRPRINT, 1, &resultobj);
- obj_dec(resultobj);
- goto return_nil;
- }
-
- static prnt_radix(n, r, buffer)
- int n, r;
- char buffer[];
- { char *p, *q, buffer2[60];
- int i, s;
-
- if (n < 0) {n = - n; s = 1;}
- else s = 0;
- p = buffer2; *p++ = '\0';
- if (n == 0) *p++ = '0';
- while (n) {
- i = n % r;
- *p++ = i + ((i < 10) ? '0' : ('A' - 10));
- n = n / r;
- }
- sprintf(buffer,"%dr", r);
- for (q = buffer; *q; q++);
- if (s) *q++ = '-';
- for (*p = '0' ; *p ; ) *q++ = *--p;
- *q = '\0';
- }
-
- static fprnt_radix(f, n, buffer)
- double f;
- int n;
- char buffer[];
- { int sign, exp, i, j;
- char *p, *q, tempbuffer[60];
- double ip;
-
- if (f < 0) {
- sign = 1;
- f = - f;
- }
- else sign = 0;
- exp = 0;
- if (f != 0) {
- exp = (int) floor(log(f) / log((double) n));
- if (exp < -4 || 4 < exp) {
- f *= pow((double) n, (double) - exp);
- }
- else exp = 0;
- }
- f = modf(f, &ip);
- if (sign) ip = - ip;
- prnt_radix((int) ip, n, buffer);
- for (p = buffer; *p; p++) ;
- if (f != 0) {
- *p++ = '.';
- for (j = 0; (f != 0) && (j < 6); j++){
- i = (int) (f *= n);
- *p++ = (i < 10) ? '0' + i : 'A' + (i-10) ;
- f -= i;
- }
- }
- if (exp) {
- *p++ = 'e';
- sprintf(tempbuffer,"%d", exp);
- for (q = tempbuffer; *q; )
- *p++ = *q++;
- }
- *p = '\0';
- return;
- }
-
- /* generalit - numerical generality */
- static int generality(aNumber)
- object *aNumber;
- { int i;
-
- if (is_integer(aNumber)) i = 1;
- else if (is_float(aNumber)) i = 2;
- else i = 3;
- return(i);
- }
-
- /* cant_happen - report that an impossible condition has occured */
- cant_happen(n) int n;
- { char *s;
-
- # ifdef SMALLDATA
- s = "what a pain!";
- # endif
- # ifndef SMALLDATA
- switch(n) {
- case 1: s = "out of memory allocation space"; break;
- case 2: s = "array size less than zero"; break;
- case 3: s = "block return from call should not occur"; break;
- case 4: s = "attempt to make instance of non class"; break;
- case 5: s = "case error in new integer or string"; break;
- case 6: s = "decrement on unknown built in object"; break;
- case 7: s = "cannot find class Object"; break;
- case 8: s = "primitive free of object of wrong type"; break;
- case 9: s = "internal interpreter error"; break;
- case 11: s = "block execute on non-block"; break;
- case 12: s = "out of symbol space"; break;
- case 14: s = "out of standard bytecode space"; break;
- case 15: s = "system deadlocked - all processes blocked"; break;
- case 16: s = "attempt to free symbol"; break;
- case 17: s = "invalid process state passed to set_state"; break;
- case 18: s = "internal buffer overflow"; break;
- case 20: s = "can't open prelude file"; break;
- case 22: s = "system file open error"; break;
- case 23: s = "fastsave error"; break;
- default: s = "unknown, but impossible nonetheless, condition"; break;
- }
- # endif
- fprintf(stderr,"Can't happen number %d: %s\n", n, s);
- exit(1);
- }
-
- /* writeable - see if a file can be written to */
- int writeable(name)
- char *name;
- { char buffer[150];
-
- sprintf(buffer,"test -w %s", name);
- # ifdef NOSYSTEM
- return(0);
- # endif
- # ifndef NOSYSTEM
- return(! system(buffer));
- # endif
- }
- End
- echo unbundling syms.c 1>&2
- cat >syms.c <<'End'
- # include "object.h"
- # include "symbol.h"
- char x_str[] = {041, 0, /* ! */
- 046, 0, /* & */
- 050, 0, /* ( */
- 051, 0, /* ) */
- 052, 0, /* * */
- 053, 0, /* + */
- 054, 0, /* , */
- 055, 0, /* - */
- 057, 0, /* / */
- 057, 057, 0, /* // */
- 074, 0, /* < */
- 074, 075, 0, /* <= */
- 075, 0, /* = */
- 075, 075, 0, /* == */
- 076, 0, /* > */
- 076, 075, 0, /* >= */
- 0100, 0, /* @ */
- 0101, 0162, 0162, 0141, 0171, 0, /* Array */
- 0101, 0162, 0162, 0141, 0171, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* ArrayedCollection */
- 0102, 0114, 0117, 0103, 0113, 0105, 0104, 0, /* BLOCKED */
- 0102, 0141, 0147, 0, /* Bag */
- 0102, 0154, 0157, 0143, 0153, 0, /* Block */
- 0102, 0157, 0157, 0154, 0145, 0141, 0156, 0, /* Boolean */
- 0102, 0171, 0164, 0145, 0101, 0162, 0162, 0141, 0171, 0, /* ByteArray */
- 0103, 0150, 0141, 0162, 0, /* Char */
- 0103, 0154, 0141, 0163, 0163, 0, /* Class */
- 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* Collection */
- 0103, 0157, 0155, 0160, 0154, 0145, 0170, 0, /* Complex */
- 0104, 0151, 0143, 0164, 0151, 0157, 0156, 0141, 0162, 0171, 0, /* Dictionary */
- 0106, 0141, 0154, 0163, 0145, 0, /* False */
- 0106, 0151, 0154, 0145, 0, /* File */
- 0106, 0154, 0157, 0141, 0164, 0, /* Float */
- 0111, 0156, 0164, 0145, 0147, 0145, 0162, 0, /* Integer */
- 0111, 0156, 0164, 0145, 0162, 0160, 0162, 0145, 0164, 0145, 0162, 0, /* Interpreter */
- 0111, 0156, 0164, 0145, 0162, 0166, 0141, 0154, 0, /* Interval */
- 0113, 0145, 0171, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* KeyedCollection */
- 0114, 0151, 0163, 0164, 0, /* List */
- 0114, 0151, 0164, 0164, 0154, 0145, 040, 0123, 0155, 0141, 0154, 0154, 0164, 0141, 0154, 0153, 0, /* Little Smalltalk */
- 0115, 0141, 0147, 0156, 0151, 0164, 0165, 0144, 0145, 0, /* Magnitude */
- 0115, 0141, 0151, 0156, 0, /* Main */
- 0116, 0165, 0155, 0142, 0145, 0162, 0, /* Number */
- 0117, 0142, 0152, 0145, 0143, 0164, 0, /* Object */
- 0117, 0162, 0144, 0145, 0162, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* OrderedCollection */
- 0120, 0157, 0151, 0156, 0164, 0, /* Point */
- 0120, 0162, 0157, 0143, 0145, 0163, 0163, 0, /* Process */
- 0122, 0105, 0101, 0104, 0131, 0, /* READY */
- 0122, 0141, 0144, 0151, 0141, 0156, 0, /* Radian */
- 0122, 0141, 0156, 0144, 0157, 0155, 0, /* Random */
- 0123, 0125, 0123, 0120, 0105, 0116, 0104, 0105, 0104, 0, /* SUSPENDED */
- 0123, 0145, 0155, 0141, 0160, 0150, 0157, 0162, 0145, 0, /* Semaphore */
- 0123, 0145, 0161, 0165, 0145, 0156, 0143, 0145, 0141, 0142, 0154, 0145, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* SequenceableCollection */
- 0123, 0145, 0164, 0, /* Set */
- 0123, 0155, 0141, 0154, 0154, 0164, 0141, 0154, 0153, 0, /* Smalltalk */
- 0123, 0164, 0162, 0151, 0156, 0147, 0, /* String */
- 0123, 0171, 0155, 0142, 0157, 0154, 0, /* Symbol */
- 0124, 0105, 0122, 0115, 0111, 0116, 0101, 0124, 0105, 0104, 0, /* TERMINATED */
- 0124, 0162, 0165, 0145, 0, /* True */
- 0125, 0156, 0144, 0145, 0146, 0151, 0156, 0145, 0144, 0117, 0142, 0152, 0145, 0143, 0164, 0, /* UndefinedObject */
- 0133, 0, /* [ */
- 0134, 0134, 0, /* \\ */
- 0134, 0134, 0134, 0134, 0, /* \\\\ */
- 0135, 0, /* ] */
- 0136, 0, /* ^ */
- 0141, 0142, 0163, 0, /* abs */
- 0141, 0144, 0144, 072, 0, /* add: */
- 0141, 0144, 0144, 072, 0141, 0146, 0164, 0145, 0162, 072, 0, /* add:after: */
- 0141, 0144, 0144, 072, 0142, 0145, 0146, 0157, 0162, 0145, 072, 0, /* add:before: */
- 0141, 0144, 0144, 072, 0167, 0151, 0164, 0150, 0117, 0143, 0143, 0165, 0162, 0162, 0145, 0156, 0143, 0145, 0163, 072, 0, /* add:withOccurrences: */
- 0141, 0144, 0144, 0101, 0154, 0154, 072, 0, /* addAll: */
- 0141, 0144, 0144, 0101, 0154, 0154, 0106, 0151, 0162, 0163, 0164, 072, 0, /* addAllFirst: */
- 0141, 0144, 0144, 0101, 0154, 0154, 0114, 0141, 0163, 0164, 072, 0, /* addAllLast: */
- 0141, 0144, 0144, 0106, 0151, 0162, 0163, 0164, 072, 0, /* addFirst: */
- 0141, 0144, 0144, 0114, 0141, 0163, 0164, 072, 0, /* addLast: */
- 0141, 0146, 0164, 0145, 0162, 072, 0, /* after: */
- 0141, 0154, 0154, 0115, 0141, 0163, 0153, 072, 0, /* allMask: */
- 0141, 0156, 0144, 072, 0, /* and: */
- 0141, 0156, 0171, 0115, 0141, 0163, 0153, 072, 0, /* anyMask: */
- 0141, 0162, 0143, 0103, 0157, 0163, 0, /* arcCos */
- 0141, 0162, 0143, 0123, 0151, 0156, 0, /* arcSin */
- 0141, 0162, 0143, 0124, 0141, 0156, 0, /* arcTan */
- 0141, 0162, 0147, 0145, 0162, 0162, 0157, 0162, 0, /* argerror */
- 0141, 0163, 0101, 0162, 0162, 0141, 0171, 0, /* asArray */
- 0141, 0163, 0102, 0141, 0147, 0, /* asBag */
- 0141, 0163, 0103, 0150, 0141, 0162, 0141, 0143, 0164, 0145, 0162, 0, /* asCharacter */
- 0141, 0163, 0104, 0151, 0143, 0164, 0151, 0157, 0156, 0141, 0162, 0171, 0, /* asDictionary */
- 0141, 0163, 0106, 0154, 0157, 0141, 0164, 0, /* asFloat */
- 0141, 0163, 0106, 0162, 0141, 0143, 0164, 0151, 0157, 0156, 0, /* asFraction */
- 0141, 0163, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 0, /* asInteger */
- 0141, 0163, 0114, 0151, 0163, 0164, 0, /* asList */
- 0141, 0163, 0114, 0157, 0167, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* asLowercase */
- 0141, 0163, 0117, 0162, 0144, 0145, 0162, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* asOrderedCollection */
- 0141, 0163, 0123, 0145, 0164, 0, /* asSet */
- 0141, 0163, 0123, 0164, 0162, 0151, 0156, 0147, 0, /* asString */
- 0141, 0163, 0123, 0171, 0155, 0142, 0157, 0154, 0, /* asSymbol */
- 0141, 0163, 0125, 0160, 0160, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* asUppercase */
- 0141, 0163, 0143, 0151, 0151, 0126, 0141, 0154, 0165, 0145, 0, /* asciiValue */
- 0141, 0164, 072, 0, /* at: */
- 0141, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* at:ifAbsent: */
- 0141, 0164, 072, 0160, 0165, 0164, 072, 0, /* at:put: */
- 0141, 0164, 0101, 0154, 0154, 072, 0160, 0165, 0164, 072, 0, /* atAll:put: */
- 0141, 0164, 0101, 0154, 0154, 0120, 0165, 0164, 072, 0, /* atAllPut: */
- 0142, 0145, 0146, 0157, 0162, 0145, 072, 0, /* before: */
- 0142, 0145, 0164, 0167, 0145, 0145, 0156, 072, 0141, 0156, 0144, 072, 0, /* between:and: */
- 0142, 0151, 0156, 0141, 0162, 0171, 0104, 0157, 072, 0, /* binaryDo: */
- 0142, 0151, 0164, 0101, 0156, 0144, 072, 0, /* bitAnd: */
- 0142, 0151, 0164, 0101, 0164, 072, 0, /* bitAt: */
- 0142, 0151, 0164, 0111, 0156, 0166, 0145, 0162, 0164, 0, /* bitInvert */
- 0142, 0151, 0164, 0117, 0162, 072, 0, /* bitOr: */
- 0142, 0151, 0164, 0123, 0150, 0151, 0146, 0164, 072, 0, /* bitShift: */
- 0142, 0151, 0164, 0130, 0157, 0162, 072, 0, /* bitXor: */
- 0142, 0154, 0157, 0143, 0153, 0, /* block */
- 0142, 0154, 0157, 0143, 0153, 0145, 0144, 0120, 0162, 0157, 0143, 0145, 0163, 0163, 0121, 0165, 0145, 0165, 0145, 0, /* blockedProcessQueue */
- 0143, 0145, 0151, 0154, 0151, 0156, 0147, 0, /* ceiling */
- 0143, 0150, 0145, 0143, 0153, 0102, 0165, 0143, 0153, 0145, 0164, 072, 0, /* checkBucket: */
- 0143, 0154, 0141, 0163, 0163, 0, /* class */
- 0143, 0154, 0145, 0141, 0156, 0125, 0160, 0, /* cleanUp */
- 0143, 0157, 0145, 0162, 0143, 0145, 072, 0, /* coerce: */
- 0143, 0157, 0154, 0154, 0145, 0143, 0164, 072, 0, /* collect: */
- 0143, 0157, 0155, 0155, 0141, 0156, 0144, 0163, 072, 0, /* commands: */
- 0143, 0157, 0155, 0160, 0141, 0162, 0145, 0105, 0162, 0162, 0157, 0162, 0, /* compareError */
- 0143, 0157, 0160, 0171, 0, /* copy */
- 0143, 0157, 0160, 0171, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* copyArguments: */
- 0143, 0157, 0160, 0171, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0164, 0157, 072, 0, /* copyArguments:to: */
- 0143, 0157, 0160, 0171, 0106, 0162, 0157, 0155, 072, 0, /* copyFrom: */
- 0143, 0157, 0160, 0171, 0106, 0162, 0157, 0155, 072, 0154, 0145, 0156, 0147, 0164, 0150, 072, 0, /* copyFrom:length: */
- 0143, 0157, 0160, 0171, 0106, 0162, 0157, 0155, 072, 0164, 0157, 072, 0, /* copyFrom:to: */
- 0143, 0157, 0160, 0171, 0127, 0151, 0164, 0150, 072, 0, /* copyWith: */
- 0143, 0157, 0160, 0171, 0127, 0151, 0164, 0150, 0157, 0165, 0164, 072, 0, /* copyWithout: */
- 0143, 0157, 0163, 0, /* cos */
- 0143, 0157, 0165, 0156, 0164, 0, /* count */
- 0143, 0165, 0162, 0162, 0101, 0163, 0163, 0157, 0143, 0, /* currAssoc */
- 0143, 0165, 0162, 0162, 0102, 0165, 0143, 0153, 0145, 0164, 0, /* currBucket */
- 0143, 0165, 0162, 0162, 0145, 0156, 0164, 0, /* current */
- 0143, 0165, 0162, 0162, 0145, 0156, 0164, 0102, 0165, 0143, 0153, 0145, 0164, 0, /* currentBucket */
- 0143, 0165, 0162, 0162, 0145, 0156, 0164, 0113, 0145, 0171, 0, /* currentKey */
- 0143, 0165, 0162, 0162, 0145, 0156, 0164, 0114, 0151, 0163, 0164, 0, /* currentList */
- 0144, 0141, 0164, 0145, 0, /* date */
- 0144, 0145, 0142, 0165, 0147, 072, 0, /* debug: */
- 0144, 0145, 0145, 0160, 0103, 0157, 0160, 0171, 0, /* deepCopy */
- 0144, 0145, 0145, 0160, 0103, 0157, 0160, 0171, 072, 0, /* deepCopy: */
- 0144, 0145, 0164, 0145, 0143, 0164, 072, 0, /* detect: */
- 0144, 0145, 0164, 0145, 0143, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* detect:ifAbsent: */
- 0144, 0145, 0164, 0145, 0143, 0164, 072, 0151, 0146, 0116, 0157, 0156, 0145, 072, 0, /* detect:ifNone: */
- 0144, 0151, 0143, 0164, 0, /* dict */
- 0144, 0151, 0143, 0164, 0151, 0157, 0156, 0141, 0162, 0171, 0, /* dictionary */
- 0144, 0151, 0147, 0151, 0164, 0126, 0141, 0154, 0165, 0145, 0, /* digitValue */
- 0144, 0151, 0147, 0151, 0164, 0126, 0141, 0154, 0165, 0145, 072, 0, /* digitValue: */
- 0144, 0151, 0163, 0160, 0154, 0141, 0171, 0, /* display */
- 0144, 0151, 0163, 0160, 0154, 0141, 0171, 0101, 0163, 0163, 0151, 0147, 0156, 0, /* displayAssign */
- 0144, 0151, 0163, 0164, 072, 0, /* dist: */
- 0144, 0157, 072, 0, /* do: */
- 0144, 0157, 0120, 0162, 0151, 0155, 0151, 0164, 0151, 0166, 0145, 072, 0, /* doPrimitive: */
- 0144, 0157, 0120, 0162, 0151, 0155, 0151, 0164, 0151, 0166, 0145, 072, 0167, 0151, 0164, 0150, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* doPrimitive:withArguments: */
- 0145, 0144, 0151, 0164, 0, /* edit */
- 0145, 0161, 0165, 0141, 0154, 0163, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0, /* equals:startingAt: */
- 0145, 0161, 0166, 072, 0, /* eqv: */
- 0145, 0162, 0162, 0157, 0162, 072, 0, /* error: */
- 0145, 0166, 0145, 0156, 0, /* even */
- 0145, 0170, 0143, 0145, 0163, 0163, 0123, 0151, 0147, 0156, 0141, 0154, 0163, 0, /* excessSignals */
- 0145, 0170, 0145, 0143, 0165, 0164, 0145, 0127, 0151, 0164, 0150, 072, 0, /* executeWith: */
- 0145, 0170, 0160, 0, /* exp */
- 0146, 0141, 0143, 0164, 0157, 0162, 0151, 0141, 0154, 0, /* factorial */
- 0146, 0151, 0156, 0144, 0101, 0163, 0163, 0157, 0143, 0151, 0141, 0164, 0151, 0157, 0156, 072, 0151, 0156, 0114, 0151, 0163, 0164, 072, 0, /* findAssociation:inList: */
- 0146, 0151, 0156, 0144, 0106, 0151, 0162, 0163, 0164, 072, 0, /* findFirst: */
- 0146, 0151, 0156, 0144, 0106, 0151, 0162, 0163, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* findFirst:ifAbsent: */
- 0146, 0151, 0156, 0144, 0114, 0141, 0163, 0164, 0, /* findLast */
- 0146, 0151, 0156, 0144, 0114, 0141, 0163, 0164, 072, 0, /* findLast: */
- 0146, 0151, 0156, 0144, 0114, 0141, 0163, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* findLast:ifAbsent: */
- 0146, 0151, 0162, 0163, 0164, 0, /* first */
- 0146, 0151, 0162, 0163, 0164, 0113, 0145, 0171, 0, /* firstKey */
- 0146, 0154, 0157, 0157, 0162, 0, /* floor */
- 0146, 0154, 0157, 0157, 0162, 0114, 0157, 0147, 072, 0, /* floorLog: */
- 0146, 0157, 0162, 0153, 0, /* fork */
- 0146, 0157, 0162, 0153, 0127, 0151, 0164, 0150, 072, 0, /* forkWith: */
- 0146, 0162, 0141, 0143, 0164, 0151, 0157, 0156, 0120, 0141, 0162, 0164, 0, /* fractionPart */
- 0146, 0162, 0145, 0145, 072, 0, /* free: */
- 0146, 0162, 0157, 0155, 072, 0, /* from: */
- 0146, 0162, 0157, 0155, 072, 0164, 0157, 072, 0, /* from:to: */
- 0146, 0162, 0157, 0155, 072, 0164, 0157, 072, 0142, 0171, 072, 0, /* from:to:by: */
- 0147, 0141, 0155, 0155, 0141, 0, /* gamma */
- 0147, 0143, 0144, 072, 0, /* gcd: */
- 0147, 0145, 0164, 0114, 0151, 0163, 0164, 072, 0, /* getList: */
- 0147, 0162, 0151, 0144, 072, 0, /* grid: */
- 0150, 0141, 0163, 0150, 0116, 0165, 0155, 0142, 0145, 0162, 072, 0, /* hashNumber: */
- 0150, 0141, 0163, 0150, 0124, 0141, 0142, 0, /* hashTab */
- 0150, 0141, 0163, 0150, 0124, 0141, 0142, 0154, 0145, 0, /* hashTable */
- 0150, 0151, 0147, 0150, 0102, 0151, 0164, 0, /* highBit */
- 0151, 0, /* i */
- 0151, 0146, 0106, 0141, 0154, 0163, 0145, 072, 0, /* ifFalse: */
- 0151, 0146, 0106, 0141, 0154, 0163, 0145, 072, 0151, 0146, 0124, 0162, 0165, 0145, 072, 0, /* ifFalse:ifTrue: */
- 0151, 0146, 0124, 0162, 0165, 0145, 072, 0, /* ifTrue: */
- 0151, 0146, 0124, 0162, 0165, 0145, 072, 0151, 0146, 0106, 0141, 0154, 0163, 0145, 072, 0, /* ifTrue:ifFalse: */
- 0151, 0156, 0122, 0141, 0156, 0147, 0145, 072, 0, /* inRange: */
- 0151, 0156, 0143, 0154, 0165, 0144, 0145, 0163, 072, 0, /* includes: */
- 0151, 0156, 0143, 0154, 0165, 0144, 0145, 0163, 0113, 0145, 0171, 072, 0, /* includesKey: */
- 0151, 0156, 0144, 0145, 0170, 0117, 0146, 072, 0, /* indexOf: */
- 0151, 0156, 0144, 0145, 0170, 0117, 0146, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* indexOf:ifAbsent: */
- 0151, 0156, 0144, 0145, 0170, 0117, 0146, 0123, 0165, 0142, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0, /* indexOfSubCollection:startingAt: */
- 0151, 0156, 0144, 0145, 0170, 0117, 0146, 0123, 0165, 0142, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* indexOfSubCollection:startingAt:ifAbsent: */
- 0151, 0156, 0151, 0164, 072, 0, /* init: */
- 0151, 0156, 0151, 0164, 072, 0163, 0165, 0160, 0145, 0162, 072, 0, /* init:super: */
- 0151, 0156, 0151, 0164, 072, 0163, 0165, 0160, 0145, 0162, 072, 0156, 0165, 0155, 0126, 0141, 0162, 0163, 072, 0, /* init:super:numVars: */
- 0151, 0156, 0152, 0145, 0143, 0164, 072, 0151, 0156, 0164, 0157, 072, 0, /* inject:into: */
- 0151, 0156, 0164, 0145, 0147, 0145, 0162, 0120, 0141, 0162, 0164, 0, /* integerPart */
- 0151, 0163, 0101, 0154, 0160, 0150, 0141, 0116, 0165, 0155, 0145, 0162, 0151, 0143, 0, /* isAlphaNumeric */
- 0151, 0163, 0104, 0151, 0147, 0151, 0164, 0, /* isDigit */
- 0151, 0163, 0105, 0155, 0160, 0164, 0171, 0, /* isEmpty */
- 0151, 0163, 0113, 0151, 0156, 0144, 0117, 0146, 072, 0, /* isKindOf: */
- 0151, 0163, 0114, 0145, 0164, 0164, 0145, 0162, 0, /* isLetter */
- 0151, 0163, 0114, 0157, 0167, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* isLowercase */
- 0151, 0163, 0115, 0145, 0155, 0142, 0145, 0162, 0117, 0146, 072, 0, /* isMemberOf: */
- 0151, 0163, 0116, 0151, 0154, 0, /* isNil */
- 0151, 0163, 0123, 0145, 0160, 0141, 0162, 0141, 0164, 0157, 0162, 0, /* isSeparator */
- 0151, 0163, 0125, 0160, 0160, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* isUppercase */
- 0151, 0163, 0126, 0157, 0167, 0145, 0154, 0, /* isVowel */
- 0153, 0145, 0171, 0163, 0, /* keys */
- 0153, 0145, 0171, 0163, 0104, 0157, 072, 0, /* keysDo: */
- 0153, 0145, 0171, 0163, 0123, 0145, 0154, 0145, 0143, 0164, 072, 0, /* keysSelect: */
- 0154, 0141, 0163, 0164, 0, /* last */
- 0154, 0141, 0163, 0164, 0113, 0145, 0171, 0, /* lastKey */
- 0154, 0143, 0155, 072, 0, /* lcm: */
- 0154, 0151, 0163, 0164, 0, /* list */
- 0154, 0156, 0, /* ln */
- 0154, 0157, 0147, 072, 0, /* log: */
- 0154, 0157, 0167, 0145, 0162, 0, /* lower */
- 0155, 0141, 0151, 0156, 0, /* main */
- 0155, 0141, 0170, 072, 0, /* max: */
- 0155, 0141, 0170, 0103, 0157, 0156, 0164, 0145, 0170, 0164, 072, 0, /* maxContext: */
- 0155, 0141, 0170, 0164, 0171, 0160, 0145, 072, 0, /* maxtype: */
- 0155, 0145, 0164, 0150, 0157, 0144, 0163, 072, 0, /* methods: */
- 0155, 0151, 0156, 072, 0, /* min: */
- 0155, 0157, 0144, 0145, 0103, 0150, 0141, 0162, 0141, 0143, 0164, 0145, 0162, 0, /* modeCharacter */
- 0155, 0157, 0144, 0145, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 0, /* modeInteger */
- 0155, 0157, 0144, 0145, 0123, 0164, 0162, 0151, 0156, 0147, 0, /* modeString */
- 0156, 0141, 0155, 0145, 072, 0, /* name: */
- 0156, 0145, 0147, 0141, 0164, 0145, 0144, 0, /* negated */
- 0156, 0145, 0147, 0141, 0164, 0151, 0166, 0145, 0, /* negative */
- 0156, 0145, 0167, 0, /* new */
- 0156, 0145, 0167, 072, 0, /* new: */
- 0156, 0145, 0167, 0120, 0162, 0157, 0143, 0145, 0163, 0163, 0, /* newProcess */
- 0156, 0145, 0167, 0120, 0162, 0157, 0143, 0145, 0163, 0163, 0127, 0151, 0164, 0150, 072, 0, /* newProcessWith: */
- 0156, 0145, 0170, 0164, 0, /* next */
- 0156, 0145, 0170, 0164, 072, 0, /* next: */
- 0156, 0157, 0104, 0151, 0163, 0160, 0154, 0141, 0171, 0, /* noDisplay */
- 0156, 0157, 0115, 0141, 0163, 0153, 072, 0, /* noMask: */
- 0156, 0157, 0164, 0, /* not */
- 0156, 0157, 0164, 0116, 0151, 0154, 0, /* notNil */
- 0156, 0157, 0164, 0150, 0151, 0156, 0147, 0, /* nothing */
- 0157, 0143, 0143, 0165, 0162, 0162, 0145, 0156, 0143, 0145, 0163, 0117, 0146, 072, 0, /* occurrencesOf: */
- 0157, 0144, 0144, 0, /* odd */
- 0157, 0160, 0105, 0162, 0162, 0157, 0162, 0, /* opError */
- 0157, 0160, 0145, 0156, 072, 0, /* open: */
- 0157, 0160, 0145, 0156, 072, 0146, 0157, 0162, 072, 0, /* open:for: */
- 0157, 0162, 072, 0, /* or: */
- 0160, 0145, 0162, 0146, 0157, 0162, 0155, 072, 0, /* perform: */
- 0160, 0145, 0162, 0146, 0157, 0162, 0155, 072, 0167, 0151, 0164, 0150, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* perform:withArguments: */
- 0160, 0151, 0, /* pi */
- 0160, 0157, 0163, 0151, 0164, 0151, 0166, 0145, 0, /* positive */
- 0160, 0162, 0151, 0156, 0164, 0, /* print */
- 0160, 0162, 0151, 0156, 0164, 0123, 0164, 0162, 0151, 0156, 0147, 0, /* printString */
- 0160, 0165, 0164, 072, 0, /* put: */
- 0161, 0165, 0157, 072, 0, /* quo: */
- 0162, 0141, 0144, 0151, 0141, 0156, 0163, 0, /* radians */
- 0162, 0141, 0144, 0151, 0170, 072, 0, /* radix: */
- 0162, 0141, 0151, 0163, 0145, 0144, 0124, 0157, 072, 0, /* raisedTo: */
- 0162, 0141, 0151, 0163, 0145, 0144, 0124, 0157, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 072, 0, /* raisedToInteger: */
- 0162, 0141, 0156, 0144, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 072, 0, /* randInteger: */
- 0162, 0141, 0156, 0144, 0157, 0155, 0151, 0172, 0145, 0, /* randomize */
- 0162, 0145, 0141, 0144, 0, /* read */
- 0162, 0145, 0143, 0151, 0160, 0162, 0157, 0143, 0141, 0154, 0, /* reciprocal */
- 0162, 0145, 0152, 0145, 0143, 0164, 072, 0, /* reject: */
- 0162, 0145, 0155, 072, 0, /* rem: */
- 0162, 0145, 0155, 0157, 0166, 0145, 072, 0, /* remove: */
- 0162, 0145, 0155, 0157, 0166, 0145, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* remove:ifAbsent: */
- 0162, 0145, 0155, 0157, 0166, 0145, 0101, 0154, 0154, 072, 0, /* removeAll: */
- 0162, 0145, 0155, 0157, 0166, 0145, 0105, 0162, 0162, 0157, 0162, 0, /* removeError */
- 0162, 0145, 0155, 0157, 0166, 0145, 0106, 0151, 0162, 0163, 0164, 0, /* removeFirst */
- 0162, 0145, 0155, 0157, 0166, 0145, 0113, 0145, 0171, 072, 0, /* removeKey: */
- 0162, 0145, 0155, 0157, 0166, 0145, 0113, 0145, 0171, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* removeKey:ifAbsent: */
- 0162, 0145, 0155, 0157, 0166, 0145, 0114, 0141, 0163, 0164, 0, /* removeLast */
- 0162, 0145, 0155, 0157, 0166, 0145, 0144, 0, /* removed */
- 0162, 0145, 0160, 0154, 0141, 0143, 0145, 0106, 0162, 0157, 0155, 072, 0164, 0157, 072, 0167, 0151, 0164, 0150, 072, 0, /* replaceFrom:to:with: */
- 0162, 0145, 0160, 0154, 0141, 0143, 0145, 0106, 0162, 0157, 0155, 072, 0164, 0157, 072, 0167, 0151, 0164, 0150, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0, /* replaceFrom:to:with:startingAt: */
- 0162, 0145, 0163, 0160, 0157, 0156, 0144, 0163, 0124, 0157, 0, /* respondsTo */
- 0162, 0145, 0163, 0160, 0157, 0156, 0144, 0163, 0124, 0157, 072, 0, /* respondsTo: */
- 0162, 0145, 0163, 0165, 0155, 0145, 0, /* resume */
- 0162, 0145, 0166, 0145, 0162, 0163, 0145, 0104, 0157, 072, 0, /* reverseDo: */
- 0162, 0145, 0166, 0145, 0162, 0163, 0145, 0144, 0, /* reversed */
- 0162, 0157, 0165, 0156, 0144, 0124, 0157, 072, 0, /* roundTo: */
- 0162, 0157, 0165, 0156, 0144, 0145, 0144, 0, /* rounded */
- 0163, 0141, 0155, 0145, 0101, 0163, 072, 0, /* sameAs: */
- 0163, 0145, 0145, 0144, 0, /* seed */
- 0163, 0145, 0154, 0145, 0143, 0164, 072, 0, /* select: */
- 0163, 0145, 0164, 0103, 0165, 0162, 0162, 0145, 0156, 0164, 0114, 0157, 0143, 0141, 0164, 0151, 0157, 0156, 072, 0, /* setCurrentLocation: */
- 0163, 0150, 072, 0, /* sh: */
- 0163, 0150, 0141, 0154, 0154, 0157, 0167, 0103, 0157, 0160, 0171, 0, /* shallowCopy */
- 0163, 0150, 0141, 0154, 0154, 0157, 0167, 0103, 0157, 0160, 0171, 072, 0, /* shallowCopy: */
- 0163, 0151, 0147, 0156, 0, /* sign */
- 0163, 0151, 0147, 0156, 0141, 0154, 0, /* signal */
- 0163, 0151, 0156, 0, /* sin */
- 0163, 0151, 0172, 0145, 0, /* size */
- 0163, 0155, 0141, 0154, 0154, 0164, 0141, 0154, 0153, 0, /* smalltalk */
- 0163, 0157, 0162, 0164, 0, /* sort */
- 0163, 0157, 0162, 0164, 072, 0, /* sort: */
- 0163, 0161, 0162, 0164, 0, /* sqrt */
- 0163, 0161, 0165, 0141, 0162, 0145, 0144, 0, /* squared */
- 0163, 0164, 0141, 0164, 0145, 0, /* state */
- 0163, 0164, 0145, 0160, 0, /* step */
- 0163, 0164, 0162, 0151, 0143, 0164, 0154, 0171, 0120, 0157, 0163, 0151, 0164, 0151, 0166, 0145, 0, /* strictlyPositive */
- 0163, 0165, 0160, 0145, 0162, 0103, 0154, 0141, 0163, 0163, 0, /* superClass */
- 0163, 0165, 0160, 0145, 0162, 0103, 0154, 0141, 0163, 0163, 072, 0, /* superClass: */
- 0163, 0165, 0163, 0160, 0145, 0156, 0144, 0, /* suspend */
- 0164, 0141, 0156, 0, /* tan */
- 0164, 0145, 0155, 0160, 0, /* temp */
- 0164, 0145, 0162, 0155, 0105, 0162, 0162, 072, 0, /* termErr: */
- 0164, 0145, 0162, 0155, 0151, 0156, 0141, 0164, 0145, 0, /* terminate */
- 0164, 0151, 0155, 0145, 072, 0, /* time: */
- 0164, 0151, 0155, 0145, 0163, 0122, 0145, 0160, 0145, 0141, 0164, 072, 0, /* timesRepeat: */
- 0164, 0157, 072, 0, /* to: */
- 0164, 0157, 072, 0142, 0171, 072, 0, /* to:by: */
- 0164, 0162, 0141, 0156, 0163, 0160, 0157, 0163, 0145, 0, /* transpose */
- 0164, 0162, 0165, 0156, 0143, 0141, 0164, 0145, 0124, 0157, 072, 0, /* truncateTo: */
- 0164, 0162, 0165, 0156, 0143, 0141, 0164, 0145, 0144, 0, /* truncated */
- 0164, 0162, 0165, 0156, 0143, 0141, 0164, 0145, 0144, 0107, 0162, 0151, 0144, 072, 0, /* truncatedGrid: */
- 0165, 0156, 0142, 0154, 0157, 0143, 0153, 0, /* unblock */
- 0165, 0160, 0160, 0145, 0162, 0, /* upper */
- 0166, 0141, 0154, 0165, 0145, 0, /* value */
- 0166, 0141, 0154, 0165, 0145, 072, 0, /* value: */
- 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value: */
- 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value:value: */
- 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value:value:value: */
- 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value:value:value:value: */
- 0166, 0141, 0154, 0165, 0145, 0163, 0, /* values */
- 0166, 0141, 0162, 0151, 0141, 0142, 0154, 0145, 0163, 0, /* variables */
- 0166, 0141, 0162, 0151, 0141, 0142, 0154, 0145, 0163, 072, 0, /* variables: */
- 0166, 0151, 0145, 0167, 0, /* view */
- 0167, 0141, 0151, 0164, 0, /* wait */
- 0167, 0150, 0151, 0154, 0145, 0106, 0141, 0154, 0163, 0145, 072, 0, /* whileFalse: */
- 0167, 0150, 0151, 0154, 0145, 0124, 0162, 0165, 0145, 072, 0, /* whileTrue: */
- 0167, 0151, 0164, 0150, 072, 0144, 0157, 072, 0, /* with:do: */
- 0167, 0151, 0164, 0150, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* withArguments: */
- 0167, 0162, 0151, 0164, 0145, 072, 0, /* write: */
- 0170, 0, /* x */
- 0170, 072, 0, /* x: */
- 0170, 0157, 0162, 072, 0, /* xor: */
- 0170, 0166, 0141, 0154, 0165, 0145, 0, /* xvalue */
- 0171, 0, /* y */
- 0171, 072, 0, /* y: */
- 0171, 0151, 0145, 0154, 0144, 0, /* yield */
- 0171, 0166, 0141, 0154, 0165, 0145, 0, /* yvalue */
- 0174, 0, /* | */
- 0176, 0, /* ~ */
- 0176, 075, 0, /* ~= */
- 0176, 0176, 0, /* ~~ */
- 0 };
- int x_cmax = 3253;
- static symbol x_sytab[] = {
- {1, SYMBOLSIZE, &x_str[0]}, /* ! */
- {1, SYMBOLSIZE, &x_str[2]}, /* & */
- {1, SYMBOLSIZE, &x_str[4]}, /* ( */
- {1, SYMBOLSIZE, &x_str[6]}, /* ) */
- {1, SYMBOLSIZE, &x_str[8]}, /* * */
- {1, SYMBOLSIZE, &x_str[10]}, /* + */
- {1, SYMBOLSIZE, &x_str[12]}, /* , */
- {1, SYMBOLSIZE, &x_str[14]}, /* - */
- {1, SYMBOLSIZE, &x_str[16]}, /* / */
- {1, SYMBOLSIZE, &x_str[18]}, /* // */
- {1, SYMBOLSIZE, &x_str[21]}, /* < */
- {1, SYMBOLSIZE, &x_str[23]}, /* <= */
- {1, SYMBOLSIZE, &x_str[26]}, /* = */
- {1, SYMBOLSIZE, &x_str[28]}, /* == */
- {1, SYMBOLSIZE, &x_str[31]}, /* > */
- {1, SYMBOLSIZE, &x_str[33]}, /* >= */
- {1, SYMBOLSIZE, &x_str[36]}, /* @ */
- {1, SYMBOLSIZE, &x_str[38]}, /* Array */
- {1, SYMBOLSIZE, &x_str[44]}, /* ArrayedCollection */
- {1, SYMBOLSIZE, &x_str[62]}, /* BLOCKED */
- {1, SYMBOLSIZE, &x_str[70]}, /* Bag */
- {1, SYMBOLSIZE, &x_str[74]}, /* Block */
- {1, SYMBOLSIZE, &x_str[80]}, /* Boolean */
- {1, SYMBOLSIZE, &x_str[88]}, /* ByteArray */
- {1, SYMBOLSIZE, &x_str[98]}, /* Char */
- {1, SYMBOLSIZE, &x_str[103]}, /* Class */
- {1, SYMBOLSIZE, &x_str[109]}, /* Collection */
- {1, SYMBOLSIZE, &x_str[120]}, /* Complex */
- {1, SYMBOLSIZE, &x_str[128]}, /* Dictionary */
- {1, SYMBOLSIZE, &x_str[139]}, /* False */
- {1, SYMBOLSIZE, &x_str[145]}, /* File */
- {1, SYMBOLSIZE, &x_str[150]}, /* Float */
- {1, SYMBOLSIZE, &x_str[156]}, /* Integer */
- {1, SYMBOLSIZE, &x_str[164]}, /* Interpreter */
- {1, SYMBOLSIZE, &x_str[176]}, /* Interval */
- {1, SYMBOLSIZE, &x_str[185]}, /* KeyedCollection */
- {1, SYMBOLSIZE, &x_str[201]}, /* List */
- {1, SYMBOLSIZE, &x_str[206]}, /* Little Smalltalk */
- {1, SYMBOLSIZE, &x_str[223]}, /* Magnitude */
- {1, SYMBOLSIZE, &x_str[233]}, /* Main */
- {1, SYMBOLSIZE, &x_str[238]}, /* Number */
- {1, SYMBOLSIZE, &x_str[245]}, /* Object */
- {1, SYMBOLSIZE, &x_str[252]}, /* OrderedCollection */
- {1, SYMBOLSIZE, &x_str[270]}, /* Point */
- {1, SYMBOLSIZE, &x_str[276]}, /* Process */
- {1, SYMBOLSIZE, &x_str[284]}, /* READY */
- {1, SYMBOLSIZE, &x_str[290]}, /* Radian */
- {1, SYMBOLSIZE, &x_str[297]}, /* Random */
- {1, SYMBOLSIZE, &x_str[304]}, /* SUSPENDED */
- {1, SYMBOLSIZE, &x_str[314]}, /* Semaphore */
- {1, SYMBOLSIZE, &x_str[324]}, /* SequenceableCollection */
- {1, SYMBOLSIZE, &x_str[347]}, /* Set */
- {1, SYMBOLSIZE, &x_str[351]}, /* Smalltalk */
- {1, SYMBOLSIZE, &x_str[361]}, /* String */
- {1, SYMBOLSIZE, &x_str[368]}, /* Symbol */
- {1, SYMBOLSIZE, &x_str[375]}, /* TERMINATED */
- {1, SYMBOLSIZE, &x_str[386]}, /* True */
- {1, SYMBOLSIZE, &x_str[391]}, /* UndefinedObject */
- {1, SYMBOLSIZE, &x_str[407]}, /* [ */
- {1, SYMBOLSIZE, &x_str[409]}, /* \\ */
- {1, SYMBOLSIZE, &x_str[412]}, /* \\\\ */
- {1, SYMBOLSIZE, &x_str[417]}, /* ] */
- {1, SYMBOLSIZE, &x_str[419]}, /* ^ */
- {1, SYMBOLSIZE, &x_str[421]}, /* abs */
- {1, SYMBOLSIZE, &x_str[425]}, /* add: */
- {1, SYMBOLSIZE, &x_str[430]}, /* add:after: */
- {1, SYMBOLSIZE, &x_str[441]}, /* add:before: */
- {1, SYMBOLSIZE, &x_str[453]}, /* add:withOccurrences: */
- {1, SYMBOLSIZE, &x_str[474]}, /* addAll: */
- {1, SYMBOLSIZE, &x_str[482]}, /* addAllFirst: */
- {1, SYMBOLSIZE, &x_str[495]}, /* addAllLast: */
- {1, SYMBOLSIZE, &x_str[507]}, /* addFirst: */
- {1, SYMBOLSIZE, &x_str[517]}, /* addLast: */
- {1, SYMBOLSIZE, &x_str[526]}, /* after: */
- {1, SYMBOLSIZE, &x_str[533]}, /* allMask: */
- {1, SYMBOLSIZE, &x_str[542]}, /* and: */
- {1, SYMBOLSIZE, &x_str[547]}, /* anyMask: */
- {1, SYMBOLSIZE, &x_str[556]}, /* arcCos */
- {1, SYMBOLSIZE, &x_str[563]}, /* arcSin */
- {1, SYMBOLSIZE, &x_str[570]}, /* arcTan */
- {1, SYMBOLSIZE, &x_str[577]}, /* argerror */
- {1, SYMBOLSIZE, &x_str[586]}, /* asArray */
- {1, SYMBOLSIZE, &x_str[594]}, /* asBag */
- {1, SYMBOLSIZE, &x_str[600]}, /* asCharacter */
- {1, SYMBOLSIZE, &x_str[612]}, /* asDictionary */
- {1, SYMBOLSIZE, &x_str[625]}, /* asFloat */
- {1, SYMBOLSIZE, &x_str[633]}, /* asFraction */
- {1, SYMBOLSIZE, &x_str[644]}, /* asInteger */
- {1, SYMBOLSIZE, &x_str[654]}, /* asList */
- {1, SYMBOLSIZE, &x_str[661]}, /* asLowercase */
- {1, SYMBOLSIZE, &x_str[673]}, /* asOrderedCollection */
- {1, SYMBOLSIZE, &x_str[693]}, /* asSet */
- {1, SYMBOLSIZE, &x_str[699]}, /* asString */
- {1, SYMBOLSIZE, &x_str[708]}, /* asSymbol */
- {1, SYMBOLSIZE, &x_str[717]}, /* asUppercase */
- {1, SYMBOLSIZE, &x_str[729]}, /* asciiValue */
- {1, SYMBOLSIZE, &x_str[740]}, /* at: */
- {1, SYMBOLSIZE, &x_str[744]}, /* at:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[757]}, /* at:put: */
- {1, SYMBOLSIZE, &x_str[765]}, /* atAll:put: */
- {1, SYMBOLSIZE, &x_str[776]}, /* atAllPut: */
- {1, SYMBOLSIZE, &x_str[786]}, /* before: */
- {1, SYMBOLSIZE, &x_str[794]}, /* between:and: */
- {1, SYMBOLSIZE, &x_str[807]}, /* binaryDo: */
- {1, SYMBOLSIZE, &x_str[817]}, /* bitAnd: */
- {1, SYMBOLSIZE, &x_str[825]}, /* bitAt: */
- {1, SYMBOLSIZE, &x_str[832]}, /* bitInvert */
- {1, SYMBOLSIZE, &x_str[842]}, /* bitOr: */
- {1, SYMBOLSIZE, &x_str[849]}, /* bitShift: */
- {1, SYMBOLSIZE, &x_str[859]}, /* bitXor: */
- {1, SYMBOLSIZE, &x_str[867]}, /* block */
- {1, SYMBOLSIZE, &x_str[873]}, /* blockedProcessQueue */
- {1, SYMBOLSIZE, &x_str[893]}, /* ceiling */
- {1, SYMBOLSIZE, &x_str[901]}, /* checkBucket: */
- {1, SYMBOLSIZE, &x_str[914]}, /* class */
- {1, SYMBOLSIZE, &x_str[920]}, /* cleanUp */
- {1, SYMBOLSIZE, &x_str[928]}, /* coerce: */
- {1, SYMBOLSIZE, &x_str[936]}, /* collect: */
- {1, SYMBOLSIZE, &x_str[945]}, /* commands: */
- {1, SYMBOLSIZE, &x_str[955]}, /* compareError */
- {1, SYMBOLSIZE, &x_str[968]}, /* copy */
- {1, SYMBOLSIZE, &x_str[973]}, /* copyArguments: */
- {1, SYMBOLSIZE, &x_str[988]}, /* copyArguments:to: */
- {1, SYMBOLSIZE, &x_str[1006]}, /* copyFrom: */
- {1, SYMBOLSIZE, &x_str[1016]}, /* copyFrom:length: */
- {1, SYMBOLSIZE, &x_str[1033]}, /* copyFrom:to: */
- {1, SYMBOLSIZE, &x_str[1046]}, /* copyWith: */
- {1, SYMBOLSIZE, &x_str[1056]}, /* copyWithout: */
- {1, SYMBOLSIZE, &x_str[1069]}, /* cos */
- {1, SYMBOLSIZE, &x_str[1073]}, /* count */
- {1, SYMBOLSIZE, &x_str[1079]}, /* currAssoc */
- {1, SYMBOLSIZE, &x_str[1089]}, /* currBucket */
- {1, SYMBOLSIZE, &x_str[1100]}, /* current */
- {1, SYMBOLSIZE, &x_str[1108]}, /* currentBucket */
- {1, SYMBOLSIZE, &x_str[1122]}, /* currentKey */
- {1, SYMBOLSIZE, &x_str[1133]}, /* currentList */
- {1, SYMBOLSIZE, &x_str[1145]}, /* date */
- {1, SYMBOLSIZE, &x_str[1150]}, /* debug: */
- {1, SYMBOLSIZE, &x_str[1157]}, /* deepCopy */
- {1, SYMBOLSIZE, &x_str[1166]}, /* deepCopy: */
- {1, SYMBOLSIZE, &x_str[1176]}, /* detect: */
- {1, SYMBOLSIZE, &x_str[1184]}, /* detect:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[1201]}, /* detect:ifNone: */
- {1, SYMBOLSIZE, &x_str[1216]}, /* dict */
- {1, SYMBOLSIZE, &x_str[1221]}, /* dictionary */
- {1, SYMBOLSIZE, &x_str[1232]}, /* digitValue */
- {1, SYMBOLSIZE, &x_str[1243]}, /* digitValue: */
- {1, SYMBOLSIZE, &x_str[1255]}, /* display */
- {1, SYMBOLSIZE, &x_str[1263]}, /* displayAssign */
- {1, SYMBOLSIZE, &x_str[1277]}, /* dist: */
- {1, SYMBOLSIZE, &x_str[1283]}, /* do: */
- {1, SYMBOLSIZE, &x_str[1287]}, /* doPrimitive: */
- {1, SYMBOLSIZE, &x_str[1300]}, /* doPrimitive:withArguments: */
- {1, SYMBOLSIZE, &x_str[1327]}, /* edit */
- {1, SYMBOLSIZE, &x_str[1332]}, /* equals:startingAt: */
- {1, SYMBOLSIZE, &x_str[1351]}, /* eqv: */
- {1, SYMBOLSIZE, &x_str[1356]}, /* error: */
- {1, SYMBOLSIZE, &x_str[1363]}, /* even */
- {1, SYMBOLSIZE, &x_str[1368]}, /* excessSignals */
- {1, SYMBOLSIZE, &x_str[1382]}, /* executeWith: */
- {1, SYMBOLSIZE, &x_str[1395]}, /* exp */
- {1, SYMBOLSIZE, &x_str[1399]}, /* factorial */
- {1, SYMBOLSIZE, &x_str[1409]}, /* findAssociation:inList: */
- {1, SYMBOLSIZE, &x_str[1433]}, /* findFirst: */
- {1, SYMBOLSIZE, &x_str[1444]}, /* findFirst:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[1464]}, /* findLast */
- {1, SYMBOLSIZE, &x_str[1473]}, /* findLast: */
- {1, SYMBOLSIZE, &x_str[1483]}, /* findLast:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[1502]}, /* first */
- {1, SYMBOLSIZE, &x_str[1508]}, /* firstKey */
- {1, SYMBOLSIZE, &x_str[1517]}, /* floor */
- {1, SYMBOLSIZE, &x_str[1523]}, /* floorLog: */
- {1, SYMBOLSIZE, &x_str[1533]}, /* fork */
- {1, SYMBOLSIZE, &x_str[1538]}, /* forkWith: */
- {1, SYMBOLSIZE, &x_str[1548]}, /* fractionPart */
- {1, SYMBOLSIZE, &x_str[1561]}, /* free: */
- {1, SYMBOLSIZE, &x_str[1567]}, /* from: */
- {1, SYMBOLSIZE, &x_str[1573]}, /* from:to: */
- {1, SYMBOLSIZE, &x_str[1582]}, /* from:to:by: */
- {1, SYMBOLSIZE, &x_str[1594]}, /* gamma */
- {1, SYMBOLSIZE, &x_str[1600]}, /* gcd: */
- {1, SYMBOLSIZE, &x_str[1605]}, /* getList: */
- {1, SYMBOLSIZE, &x_str[1614]}, /* grid: */
- {1, SYMBOLSIZE, &x_str[1620]}, /* hashNumber: */
- {1, SYMBOLSIZE, &x_str[1632]}, /* hashTab */
- {1, SYMBOLSIZE, &x_str[1640]}, /* hashTable */
- {1, SYMBOLSIZE, &x_str[1650]}, /* highBit */
- {1, SYMBOLSIZE, &x_str[1658]}, /* i */
- {1, SYMBOLSIZE, &x_str[1660]}, /* ifFalse: */
- {1, SYMBOLSIZE, &x_str[1669]}, /* ifFalse:ifTrue: */
- {1, SYMBOLSIZE, &x_str[1685]}, /* ifTrue: */
- {1, SYMBOLSIZE, &x_str[1693]}, /* ifTrue:ifFalse: */
- {1, SYMBOLSIZE, &x_str[1709]}, /* inRange: */
- {1, SYMBOLSIZE, &x_str[1718]}, /* includes: */
- {1, SYMBOLSIZE, &x_str[1728]}, /* includesKey: */
- {1, SYMBOLSIZE, &x_str[1741]}, /* indexOf: */
- {1, SYMBOLSIZE, &x_str[1750]}, /* indexOf:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[1768]}, /* indexOfSubCollection:startingAt: */
- {1, SYMBOLSIZE, &x_str[1801]}, /* indexOfSubCollection:startingAt:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[1843]}, /* init: */
- {1, SYMBOLSIZE, &x_str[1849]}, /* init:super: */
- {1, SYMBOLSIZE, &x_str[1861]}, /* init:super:numVars: */
- {1, SYMBOLSIZE, &x_str[1881]}, /* inject:into: */
- {1, SYMBOLSIZE, &x_str[1894]}, /* integerPart */
- {1, SYMBOLSIZE, &x_str[1906]}, /* isAlphaNumeric */
- {1, SYMBOLSIZE, &x_str[1921]}, /* isDigit */
- {1, SYMBOLSIZE, &x_str[1929]}, /* isEmpty */
- {1, SYMBOLSIZE, &x_str[1937]}, /* isKindOf: */
- {1, SYMBOLSIZE, &x_str[1947]}, /* isLetter */
- {1, SYMBOLSIZE, &x_str[1956]}, /* isLowercase */
- {1, SYMBOLSIZE, &x_str[1968]}, /* isMemberOf: */
- {1, SYMBOLSIZE, &x_str[1980]}, /* isNil */
- {1, SYMBOLSIZE, &x_str[1986]}, /* isSeparator */
- {1, SYMBOLSIZE, &x_str[1998]}, /* isUppercase */
- {1, SYMBOLSIZE, &x_str[2010]}, /* isVowel */
- {1, SYMBOLSIZE, &x_str[2018]}, /* keys */
- {1, SYMBOLSIZE, &x_str[2023]}, /* keysDo: */
- {1, SYMBOLSIZE, &x_str[2031]}, /* keysSelect: */
- {1, SYMBOLSIZE, &x_str[2043]}, /* last */
- {1, SYMBOLSIZE, &x_str[2048]}, /* lastKey */
- {1, SYMBOLSIZE, &x_str[2056]}, /* lcm: */
- {1, SYMBOLSIZE, &x_str[2061]}, /* list */
- {1, SYMBOLSIZE, &x_str[2066]}, /* ln */
- {1, SYMBOLSIZE, &x_str[2069]}, /* log: */
- {1, SYMBOLSIZE, &x_str[2074]}, /* lower */
- {1, SYMBOLSIZE, &x_str[2080]}, /* main */
- {1, SYMBOLSIZE, &x_str[2085]}, /* max: */
- {1, SYMBOLSIZE, &x_str[2090]}, /* maxContext: */
- {1, SYMBOLSIZE, &x_str[2102]}, /* maxtype: */
- {1, SYMBOLSIZE, &x_str[2111]}, /* methods: */
- {1, SYMBOLSIZE, &x_str[2120]}, /* min: */
- {1, SYMBOLSIZE, &x_str[2125]}, /* modeCharacter */
- {1, SYMBOLSIZE, &x_str[2139]}, /* modeInteger */
- {1, SYMBOLSIZE, &x_str[2151]}, /* modeString */
- {1, SYMBOLSIZE, &x_str[2162]}, /* name: */
- {1, SYMBOLSIZE, &x_str[2168]}, /* negated */
- {1, SYMBOLSIZE, &x_str[2176]}, /* negative */
- {1, SYMBOLSIZE, &x_str[2185]}, /* new */
- {1, SYMBOLSIZE, &x_str[2189]}, /* new: */
- {1, SYMBOLSIZE, &x_str[2194]}, /* newProcess */
- {1, SYMBOLSIZE, &x_str[2205]}, /* newProcessWith: */
- {1, SYMBOLSIZE, &x_str[2221]}, /* next */
- {1, SYMBOLSIZE, &x_str[2226]}, /* next: */
- {1, SYMBOLSIZE, &x_str[2232]}, /* noDisplay */
- {1, SYMBOLSIZE, &x_str[2242]}, /* noMask: */
- {1, SYMBOLSIZE, &x_str[2250]}, /* not */
- {1, SYMBOLSIZE, &x_str[2254]}, /* notNil */
- {1, SYMBOLSIZE, &x_str[2261]}, /* nothing */
- {1, SYMBOLSIZE, &x_str[2269]}, /* occurrencesOf: */
- {1, SYMBOLSIZE, &x_str[2284]}, /* odd */
- {1, SYMBOLSIZE, &x_str[2288]}, /* opError */
- {1, SYMBOLSIZE, &x_str[2296]}, /* open: */
- {1, SYMBOLSIZE, &x_str[2302]}, /* open:for: */
- {1, SYMBOLSIZE, &x_str[2312]}, /* or: */
- {1, SYMBOLSIZE, &x_str[2316]}, /* perform: */
- {1, SYMBOLSIZE, &x_str[2325]}, /* perform:withArguments: */
- {1, SYMBOLSIZE, &x_str[2348]}, /* pi */
- {1, SYMBOLSIZE, &x_str[2351]}, /* positive */
- {1, SYMBOLSIZE, &x_str[2360]}, /* print */
- {1, SYMBOLSIZE, &x_str[2366]}, /* printString */
- {1, SYMBOLSIZE, &x_str[2378]}, /* put: */
- {1, SYMBOLSIZE, &x_str[2383]}, /* quo: */
- {1, SYMBOLSIZE, &x_str[2388]}, /* radians */
- {1, SYMBOLSIZE, &x_str[2396]}, /* radix: */
- {1, SYMBOLSIZE, &x_str[2403]}, /* raisedTo: */
- {1, SYMBOLSIZE, &x_str[2413]}, /* raisedToInteger: */
- {1, SYMBOLSIZE, &x_str[2430]}, /* randInteger: */
- {1, SYMBOLSIZE, &x_str[2443]}, /* randomize */
- {1, SYMBOLSIZE, &x_str[2453]}, /* read */
- {1, SYMBOLSIZE, &x_str[2458]}, /* reciprocal */
- {1, SYMBOLSIZE, &x_str[2469]}, /* reject: */
- {1, SYMBOLSIZE, &x_str[2477]}, /* rem: */
- {1, SYMBOLSIZE, &x_str[2482]}, /* remove: */
- {1, SYMBOLSIZE, &x_str[2490]}, /* remove:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[2507]}, /* removeAll: */
- {1, SYMBOLSIZE, &x_str[2518]}, /* removeError */
- {1, SYMBOLSIZE, &x_str[2530]}, /* removeFirst */
- {1, SYMBOLSIZE, &x_str[2542]}, /* removeKey: */
- {1, SYMBOLSIZE, &x_str[2553]}, /* removeKey:ifAbsent: */
- {1, SYMBOLSIZE, &x_str[2573]}, /* removeLast */
- {1, SYMBOLSIZE, &x_str[2584]}, /* removed */
- {1, SYMBOLSIZE, &x_str[2592]}, /* replaceFrom:to:with: */
- {1, SYMBOLSIZE, &x_str[2613]}, /* replaceFrom:to:with:startingAt: */
- {1, SYMBOLSIZE, &x_str[2645]}, /* respondsTo */
- {1, SYMBOLSIZE, &x_str[2656]}, /* respondsTo: */
- {1, SYMBOLSIZE, &x_str[2668]}, /* resume */
- {1, SYMBOLSIZE, &x_str[2675]}, /* reverseDo: */
- {1, SYMBOLSIZE, &x_str[2686]}, /* reversed */
- {1, SYMBOLSIZE, &x_str[2695]}, /* roundTo: */
- {1, SYMBOLSIZE, &x_str[2704]}, /* rounded */
- {1, SYMBOLSIZE, &x_str[2712]}, /* sameAs: */
- {1, SYMBOLSIZE, &x_str[2720]}, /* seed */
- {1, SYMBOLSIZE, &x_str[2725]}, /* select: */
- {1, SYMBOLSIZE, &x_str[2733]}, /* setCurrentLocation: */
- {1, SYMBOLSIZE, &x_str[2753]}, /* sh: */
- {1, SYMBOLSIZE, &x_str[2757]}, /* shallowCopy */
- {1, SYMBOLSIZE, &x_str[2769]}, /* shallowCopy: */
- {1, SYMBOLSIZE, &x_str[2782]}, /* sign */
- {1, SYMBOLSIZE, &x_str[2787]}, /* signal */
- {1, SYMBOLSIZE, &x_str[2794]}, /* sin */
- {1, SYMBOLSIZE, &x_str[2798]}, /* size */
- {1, SYMBOLSIZE, &x_str[2803]}, /* smalltalk */
- {1, SYMBOLSIZE, &x_str[2813]}, /* sort */
- {1, SYMBOLSIZE, &x_str[2818]}, /* sort: */
- {1, SYMBOLSIZE, &x_str[2824]}, /* sqrt */
- {1, SYMBOLSIZE, &x_str[2829]}, /* squared */
- {1, SYMBOLSIZE, &x_str[2837]}, /* state */
- {1, SYMBOLSIZE, &x_str[2843]}, /* step */
- {1, SYMBOLSIZE, &x_str[2848]}, /* strictlyPositive */
- {1, SYMBOLSIZE, &x_str[2865]}, /* superClass */
- {1, SYMBOLSIZE, &x_str[2876]}, /* superClass: */
- {1, SYMBOLSIZE, &x_str[2888]}, /* suspend */
- {1, SYMBOLSIZE, &x_str[2896]}, /* tan */
- {1, SYMBOLSIZE, &x_str[2900]}, /* temp */
- {1, SYMBOLSIZE, &x_str[2905]}, /* termErr: */
- {1, SYMBOLSIZE, &x_str[2914]}, /* terminate */
- {1, SYMBOLSIZE, &x_str[2924]}, /* time: */
- {1, SYMBOLSIZE, &x_str[2930]}, /* timesRepeat: */
- {1, SYMBOLSIZE, &x_str[2943]}, /* to: */
- {1, SYMBOLSIZE, &x_str[2947]}, /* to:by: */
- {1, SYMBOLSIZE, &x_str[2954]}, /* transpose */
- {1, SYMBOLSIZE, &x_str[2964]}, /* truncateTo: */
- {1, SYMBOLSIZE, &x_str[2976]}, /* truncated */
- {1, SYMBOLSIZE, &x_str[2986]}, /* truncatedGrid: */
- {1, SYMBOLSIZE, &x_str[3001]}, /* unblock */
- {1, SYMBOLSIZE, &x_str[3009]}, /* upper */
- {1, SYMBOLSIZE, &x_str[3015]}, /* value */
- {1, SYMBOLSIZE, &x_str[3021]}, /* value: */
- {1, SYMBOLSIZE, &x_str[3028]}, /* value:value: */
- {1, SYMBOLSIZE, &x_str[3041]}, /* value:value:value: */
- {1, SYMBOLSIZE, &x_str[3060]}, /* value:value:value:value: */
- {1, SYMBOLSIZE, &x_str[3085]}, /* value:value:value:value:value: */
- {1, SYMBOLSIZE, &x_str[3116]}, /* values */
- {1, SYMBOLSIZE, &x_str[3123]}, /* variables */
- {1, SYMBOLSIZE, &x_str[3133]}, /* variables: */
- {1, SYMBOLSIZE, &x_str[3144]}, /* view */
- {1, SYMBOLSIZE, &x_str[3149]}, /* wait */
- {1, SYMBOLSIZE, &x_str[3154]}, /* whileFalse: */
- {1, SYMBOLSIZE, &x_str[3166]}, /* whileTrue: */
- {1, SYMBOLSIZE, &x_str[3177]}, /* with:do: */
- {1, SYMBOLSIZE, &x_str[3186]}, /* withArguments: */
- {1, SYMBOLSIZE, &x_str[3201]}, /* write: */
- {1, SYMBOLSIZE, &x_str[3208]}, /* x */
- {1, SYMBOLSIZE, &x_str[3210]}, /* x: */
- {1, SYMBOLSIZE, &x_str[3213]}, /* xor: */
- {1, SYMBOLSIZE, &x_str[3218]}, /* xvalue */
- {1, SYMBOLSIZE, &x_str[3225]}, /* y */
- {1, SYMBOLSIZE, &x_str[3227]}, /* y: */
- {1, SYMBOLSIZE, &x_str[3230]}, /* yield */
- {1, SYMBOLSIZE, &x_str[3236]}, /* yvalue */
- {1, SYMBOLSIZE, &x_str[3243]}, /* | */
- {1, SYMBOLSIZE, &x_str[3245]}, /* ~ */
- {1, SYMBOLSIZE, &x_str[3247]}, /* ~= */
- {1, SYMBOLSIZE, &x_str[3250]}, /* ~~ */
- 0};
- symbol *x_tab[SYMTABMAX] = {
- &x_sytab[0], /* ! */
- &x_sytab[1], /* & */
- &x_sytab[2], /* ( */
- &x_sytab[3], /* ) */
- &x_sytab[4], /* * */
- &x_sytab[5], /* + */
- &x_sytab[6], /* , */
- &x_sytab[7], /* - */
- &x_sytab[8], /* / */
- &x_sytab[9], /* // */
- &x_sytab[10], /* < */
- &x_sytab[11], /* <= */
- &x_sytab[12], /* = */
- &x_sytab[13], /* == */
- &x_sytab[14], /* > */
- &x_sytab[15], /* >= */
- &x_sytab[16], /* @ */
- &x_sytab[17], /* Array */
- &x_sytab[18], /* ArrayedCollection */
- &x_sytab[19], /* BLOCKED */
- &x_sytab[20], /* Bag */
- &x_sytab[21], /* Block */
- &x_sytab[22], /* Boolean */
- &x_sytab[23], /* ByteArray */
- &x_sytab[24], /* Char */
- &x_sytab[25], /* Class */
- &x_sytab[26], /* Collection */
- &x_sytab[27], /* Complex */
- &x_sytab[28], /* Dictionary */
- &x_sytab[29], /* False */
- &x_sytab[30], /* File */
- &x_sytab[31], /* Float */
- &x_sytab[32], /* Integer */
- &x_sytab[33], /* Interpreter */
- &x_sytab[34], /* Interval */
- &x_sytab[35], /* KeyedCollection */
- &x_sytab[36], /* List */
- &x_sytab[37], /* Little Smalltalk */
- &x_sytab[38], /* Magnitude */
- &x_sytab[39], /* Main */
- &x_sytab[40], /* Number */
- &x_sytab[41], /* Object */
- &x_sytab[42], /* OrderedCollection */
- &x_sytab[43], /* Point */
- &x_sytab[44], /* Process */
- &x_sytab[45], /* READY */
- &x_sytab[46], /* Radian */
- &x_sytab[47], /* Random */
- &x_sytab[48], /* SUSPENDED */
- &x_sytab[49], /* Semaphore */
- &x_sytab[50], /* SequenceableCollection */
- &x_sytab[51], /* Set */
- &x_sytab[52], /* Smalltalk */
- &x_sytab[53], /* String */
- &x_sytab[54], /* Symbol */
- &x_sytab[55], /* TERMINATED */
- &x_sytab[56], /* True */
- &x_sytab[57], /* UndefinedObject */
- &x_sytab[58], /* [ */
- &x_sytab[59], /* \\ */
- &x_sytab[60], /* \\\\ */
- &x_sytab[61], /* ] */
- &x_sytab[62], /* ^ */
- &x_sytab[63], /* abs */
- &x_sytab[64], /* add: */
- &x_sytab[65], /* add:after: */
- &x_sytab[66], /* add:before: */
- &x_sytab[67], /* add:withOccurrences: */
- &x_sytab[68], /* addAll: */
- &x_sytab[69], /* addAllFirst: */
- &x_sytab[70], /* addAllLast: */
- &x_sytab[71], /* addFirst: */
- &x_sytab[72], /* addLast: */
- &x_sytab[73], /* after: */
- &x_sytab[74], /* allMask: */
- &x_sytab[75], /* and: */
- &x_sytab[76], /* anyMask: */
- &x_sytab[77], /* arcCos */
- &x_sytab[78], /* arcSin */
- &x_sytab[79], /* arcTan */
- &x_sytab[80], /* argerror */
- &x_sytab[81], /* asArray */
- &x_sytab[82], /* asBag */
- &x_sytab[83], /* asCharacter */
- &x_sytab[84], /* asDictionary */
- &x_sytab[85], /* asFloat */
- &x_sytab[86], /* asFraction */
- &x_sytab[87], /* asInteger */
- &x_sytab[88], /* asList */
- &x_sytab[89], /* asLowercase */
- &x_sytab[90], /* asOrderedCollection */
- &x_sytab[91], /* asSet */
- &x_sytab[92], /* asString */
- &x_sytab[93], /* asSymbol */
- &x_sytab[94], /* asUppercase */
- &x_sytab[95], /* asciiValue */
- &x_sytab[96], /* at: */
- &x_sytab[97], /* at:ifAbsent: */
- &x_sytab[98], /* at:put: */
- &x_sytab[99], /* atAll:put: */
- &x_sytab[100], /* atAllPut: */
- &x_sytab[101], /* before: */
- &x_sytab[102], /* between:and: */
- &x_sytab[103], /* binaryDo: */
- &x_sytab[104], /* bitAnd: */
- &x_sytab[105], /* bitAt: */
- &x_sytab[106], /* bitInvert */
- &x_sytab[107], /* bitOr: */
- &x_sytab[108], /* bitShift: */
- &x_sytab[109], /* bitXor: */
- &x_sytab[110], /* block */
- &x_sytab[111], /* blockedProcessQueue */
- &x_sytab[112], /* ceiling */
- &x_sytab[113], /* checkBucket: */
- &x_sytab[114], /* class */
- &x_sytab[115], /* cleanUp */
- &x_sytab[116], /* coerce: */
- &x_sytab[117], /* collect: */
- &x_sytab[118], /* commands: */
- &x_sytab[119], /* compareError */
- &x_sytab[120], /* copy */
- &x_sytab[121], /* copyArguments: */
- &x_sytab[122], /* copyArguments:to: */
- &x_sytab[123], /* copyFrom: */
- &x_sytab[124], /* copyFrom:length: */
- &x_sytab[125], /* copyFrom:to: */
- &x_sytab[126], /* copyWith: */
- &x_sytab[127], /* copyWithout: */
- &x_sytab[128], /* cos */
- &x_sytab[129], /* count */
- &x_sytab[130], /* currAssoc */
- &x_sytab[131], /* currBucket */
- &x_sytab[132], /* current */
- &x_sytab[133], /* currentBucket */
- &x_sytab[134], /* currentKey */
- &x_sytab[135], /* currentList */
- &x_sytab[136], /* date */
- &x_sytab[137], /* debug: */
- &x_sytab[138], /* deepCopy */
- &x_sytab[139], /* deepCopy: */
- &x_sytab[140], /* detect: */
- &x_sytab[141], /* detect:ifAbsent: */
- &x_sytab[142], /* detect:ifNone: */
- &x_sytab[143], /* dict */
- &x_sytab[144], /* dictionary */
- &x_sytab[145], /* digitValue */
- &x_sytab[146], /* digitValue: */
- &x_sytab[147], /* display */
- &x_sytab[148], /* displayAssign */
- &x_sytab[149], /* dist: */
- &x_sytab[150], /* do: */
- &x_sytab[151], /* doPrimitive: */
- &x_sytab[152], /* doPrimitive:withArguments: */
- &x_sytab[153], /* edit */
- &x_sytab[154], /* equals:startingAt: */
- &x_sytab[155], /* eqv: */
- &x_sytab[156], /* error: */
- &x_sytab[157], /* even */
- &x_sytab[158], /* excessSignals */
- &x_sytab[159], /* executeWith: */
- &x_sytab[160], /* exp */
- &x_sytab[161], /* factorial */
- &x_sytab[162], /* findAssociation:inList: */
- &x_sytab[163], /* findFirst: */
- &x_sytab[164], /* findFirst:ifAbsent: */
- &x_sytab[165], /* findLast */
- &x_sytab[166], /* findLast: */
- &x_sytab[167], /* findLast:ifAbsent: */
- &x_sytab[168], /* first */
- &x_sytab[169], /* firstKey */
- &x_sytab[170], /* floor */
- &x_sytab[171], /* floorLog: */
- &x_sytab[172], /* fork */
- &x_sytab[173], /* forkWith: */
- &x_sytab[174], /* fractionPart */
- &x_sytab[175], /* free: */
- &x_sytab[176], /* from: */
- &x_sytab[177], /* from:to: */
- &x_sytab[178], /* from:to:by: */
- &x_sytab[179], /* gamma */
- &x_sytab[180], /* gcd: */
- &x_sytab[181], /* getList: */
- &x_sytab[182], /* grid: */
- &x_sytab[183], /* hashNumber: */
- &x_sytab[184], /* hashTab */
- &x_sytab[185], /* hashTable */
- &x_sytab[186], /* highBit */
- &x_sytab[187], /* i */
- &x_sytab[188], /* ifFalse: */
- &x_sytab[189], /* ifFalse:ifTrue: */
- &x_sytab[190], /* ifTrue: */
- &x_sytab[191], /* ifTrue:ifFalse: */
- &x_sytab[192], /* inRange: */
- &x_sytab[193], /* includes: */
- &x_sytab[194], /* includesKey: */
- &x_sytab[195], /* indexOf: */
- &x_sytab[196], /* indexOf:ifAbsent: */
- &x_sytab[197], /* indexOfSubCollection:startingAt: */
- &x_sytab[198], /* indexOfSubCollection:startingAt:ifAbsent: */
- &x_sytab[199], /* init: */
- &x_sytab[200], /* init:super: */
- &x_sytab[201], /* init:super:numVars: */
- &x_sytab[202], /* inject:into: */
- &x_sytab[203], /* integerPart */
- &x_sytab[204], /* isAlphaNumeric */
- &x_sytab[205], /* isDigit */
- &x_sytab[206], /* isEmpty */
- &x_sytab[207], /* isKindOf: */
- &x_sytab[208], /* isLetter */
- &x_sytab[209], /* isLowercase */
- &x_sytab[210], /* isMemberOf: */
- &x_sytab[211], /* isNil */
- &x_sytab[212], /* isSeparator */
- &x_sytab[213], /* isUppercase */
- &x_sytab[214], /* isVowel */
- &x_sytab[215], /* keys */
- &x_sytab[216], /* keysDo: */
- &x_sytab[217], /* keysSelect: */
- &x_sytab[218], /* last */
- &x_sytab[219], /* lastKey */
- &x_sytab[220], /* lcm: */
- &x_sytab[221], /* list */
- &x_sytab[222], /* ln */
- &x_sytab[223], /* log: */
- &x_sytab[224], /* lower */
- &x_sytab[225], /* main */
- &x_sytab[226], /* max: */
- &x_sytab[227], /* maxContext: */
- &x_sytab[228], /* maxtype: */
- &x_sytab[229], /* methods: */
- &x_sytab[230], /* min: */
- &x_sytab[231], /* modeCharacter */
- &x_sytab[232], /* modeInteger */
- &x_sytab[233], /* modeString */
- &x_sytab[234], /* name: */
- &x_sytab[235], /* negated */
- &x_sytab[236], /* negative */
- &x_sytab[237], /* new */
- &x_sytab[238], /* new: */
- &x_sytab[239], /* newProcess */
- &x_sytab[240], /* newProcessWith: */
- &x_sytab[241], /* next */
- &x_sytab[242], /* next: */
- &x_sytab[243], /* noDisplay */
- &x_sytab[244], /* noMask: */
- &x_sytab[245], /* not */
- &x_sytab[246], /* notNil */
- &x_sytab[247], /* nothing */
- &x_sytab[248], /* occurrencesOf: */
- &x_sytab[249], /* odd */
- &x_sytab[250], /* opError */
- &x_sytab[251], /* open: */
- &x_sytab[252], /* open:for: */
- &x_sytab[253], /* or: */
- &x_sytab[254], /* perform: */
- &x_sytab[255], /* perform:withArguments: */
- &x_sytab[256], /* pi */
- &x_sytab[257], /* positive */
- &x_sytab[258], /* print */
- &x_sytab[259], /* printString */
- &x_sytab[260], /* put: */
- &x_sytab[261], /* quo: */
- &x_sytab[262], /* radians */
- &x_sytab[263], /* radix: */
- &x_sytab[264], /* raisedTo: */
- &x_sytab[265], /* raisedToInteger: */
- &x_sytab[266], /* randInteger: */
- &x_sytab[267], /* randomize */
- &x_sytab[268], /* read */
- &x_sytab[269], /* reciprocal */
- &x_sytab[270], /* reject: */
- &x_sytab[271], /* rem: */
- &x_sytab[272], /* remove: */
- &x_sytab[273], /* remove:ifAbsent: */
- &x_sytab[274], /* removeAll: */
- &x_sytab[275], /* removeError */
- &x_sytab[276], /* removeFirst */
- &x_sytab[277], /* removeKey: */
- &x_sytab[278], /* removeKey:ifAbsent: */
- &x_sytab[279], /* removeLast */
- &x_sytab[280], /* removed */
- &x_sytab[281], /* replaceFrom:to:with: */
- &x_sytab[282], /* replaceFrom:to:with:startingAt: */
- &x_sytab[283], /* respondsTo */
- &x_sytab[284], /* respondsTo: */
- &x_sytab[285], /* resume */
- &x_sytab[286], /* reverseDo: */
- &x_sytab[287], /* reversed */
- &x_sytab[288], /* roundTo: */
- &x_sytab[289], /* rounded */
- &x_sytab[290], /* sameAs: */
- &x_sytab[291], /* seed */
- &x_sytab[292], /* select: */
- &x_sytab[293], /* setCurrentLocation: */
- &x_sytab[294], /* sh: */
- &x_sytab[295], /* shallowCopy */
- &x_sytab[296], /* shallowCopy: */
- &x_sytab[297], /* sign */
- &x_sytab[298], /* signal */
- &x_sytab[299], /* sin */
- &x_sytab[300], /* size */
- &x_sytab[301], /* smalltalk */
- &x_sytab[302], /* sort */
- &x_sytab[303], /* sort: */
- &x_sytab[304], /* sqrt */
- &x_sytab[305], /* squared */
- &x_sytab[306], /* state */
- &x_sytab[307], /* step */
- &x_sytab[308], /* strictlyPositive */
- &x_sytab[309], /* superClass */
- &x_sytab[310], /* superClass: */
- &x_sytab[311], /* suspend */
- &x_sytab[312], /* tan */
- &x_sytab[313], /* temp */
- &x_sytab[314], /* termErr: */
- &x_sytab[315], /* terminate */
- &x_sytab[316], /* time: */
- &x_sytab[317], /* timesRepeat: */
- &x_sytab[318], /* to: */
- &x_sytab[319], /* to:by: */
- &x_sytab[320], /* transpose */
- &x_sytab[321], /* truncateTo: */
- &x_sytab[322], /* truncated */
- &x_sytab[323], /* truncatedGrid: */
- &x_sytab[324], /* unblock */
- &x_sytab[325], /* upper */
- &x_sytab[326], /* value */
- &x_sytab[327], /* value: */
- &x_sytab[328], /* value:value: */
- &x_sytab[329], /* value:value:value: */
- &x_sytab[330], /* value:value:value:value: */
- &x_sytab[331], /* value:value:value:value:value: */
- &x_sytab[332], /* values */
- &x_sytab[333], /* variables */
- &x_sytab[334], /* variables: */
- &x_sytab[335], /* view */
- &x_sytab[336], /* wait */
- &x_sytab[337], /* whileFalse: */
- &x_sytab[338], /* whileTrue: */
- &x_sytab[339], /* with:do: */
- &x_sytab[340], /* withArguments: */
- &x_sytab[341], /* write: */
- &x_sytab[342], /* x */
- &x_sytab[343], /* x: */
- &x_sytab[344], /* xor: */
- &x_sytab[345], /* xvalue */
- &x_sytab[346], /* y */
- &x_sytab[347], /* y: */
- &x_sytab[348], /* yield */
- &x_sytab[349], /* yvalue */
- &x_sytab[350], /* | */
- &x_sytab[351], /* ~ */
- &x_sytab[352], /* ~= */
- &x_sytab[353], /* ~~ */
- 0};
- int x_tmax = 353;
- End
- echo unbundling cldict.c 1>&2
- cat >cldict.c <<'End'
- /*
- Little Smalltalk
- Internal class dictionary
-
- timothy a. budd, 10/84
-
- In order to facilitate lookup, classes are kept in an internal data
- dictionary. Classes are inserted into this dictionary using a
- primtitive, and are removed by either being overridden, or being
- flushed at the end of execution.
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "number.h"
- # include "symbol.h"
- # include "primitive.h"
-
- struct class_entry { /* structure for internal dictionary */
- char *cl_name;
- object *cl_description;
- struct class_entry *cl_link;
- };
-
- static struct class_entry *class_dictionary = 0;
- int ca_cdict = 0;
- static mstruct *fr_cdict = 0; /* class dictionary free list */
-
- # define CDICTINIT 30
- static struct class_entry cdsinit[CDICTINIT];
-
- /* cdic_init - initialize the internal class dictionary */
- cdic_init() {
- struct class_entry *p;
- mstruct *new;
- int i;
-
- for (p = cdsinit, i = 0; i < CDICTINIT; i++, p++) {
- new = (mstruct *) p;
- new->mlink = fr_cdict;
- fr_cdict = new;
- }
- }
-
- /* enter_class - enter a class into the internal class dictionary */
- enter_class(name, description)
- char *name;
- object *description;
- { struct class_entry *p;
-
- for (p = class_dictionary; p; p = p->cl_link)
- if (strcmp(name, p->cl_name) == 0) {
- assign(p->cl_description, description);
- return;
- }
- /* not found, make a new entry */
- if (fr_cdict) {
- p = (struct class_entry *) fr_cdict;
- fr_cdict = fr_cdict->mlink;
- }
- else {
- p = structalloc(struct class_entry);
- ca_cdict++;
- }
- p->cl_name = name;
- sassign(p->cl_description, description);
- p->cl_link = class_dictionary;
- class_dictionary = p;
- }
-
- /* lookup - take a name and find the associated class object */
- object *lookup_class(name)
- char *name;
- { struct class_entry *p;
-
- for (p = class_dictionary; p; p = p->cl_link)
- if (strcmp(name, p->cl_name) == 0)
- return(p->cl_description);
- return((object *) 0);
- }
-
- /* free_all_classes - flush all references for the class dictionary */
- free_all_classes()
- { struct class_entry *p;
-
- for (p = class_dictionary; p; p = p->cl_link) {
- obj_dec(p->cl_description);
- }
- }
-
- /* class_list - list all the subclasses of a class (recursively),
- indenting by a specified number of tab stops */
- class_list(c, n)
- class *c;
- int n;
- { struct class_entry *p;
- object *prs[2];
- class *q;
- char *name;
-
- /* first print out this class name */
- if (! is_symbol(c->class_name))
- return;
- sassign(prs[0], c->class_name);
- name = symbol_value(c->class_name);
- sassign(prs[1], new_int(n));
- primitive(SYMPRINT, 2, prs);
- obj_dec(prs[0]);
- obj_dec(prs[1]);
-
- /* now find all subclasses and print them out */
- for (p = class_dictionary; p; p = p->cl_link) {
- q = (class *) p->cl_description;
- if ((is_symbol(q->super_class)) &&
- (strcmp(name, symbol_value(q->super_class)) == 0) )
- class_list(q, n+1);
- }
- }
- End
- echo unbundling process.c 1>&2
- cat >process.c <<'End'
- /*
- Little Smalltalk
-
- process manager
- dennis a. vadner and michael t. benhase, 11/84
- modified by timothy a. budd 4/85
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
-
- # include "object.h"
-
- # include <stdio.h>
-
- # ifdef SIGS
- # include <signal.h>
- # endif
-
- # ifdef SETJUMP
- # include <setjmp.h>
- # endif
-
- # include "drive.h"
- # include "interp.h"
- # include "process.h"
-
- extern int test_driver(); /* routine to test for user keystrokes*/
-
- static process *currentProcess; /* current process */
- static process *fr_process = 0; /* process memory free list */
-
- int atomcnt = 0; /* atomic action flag */
- process *runningProcess; /* currently running process,
- may be different from
- currentProcess during process
- termination */
-
- # define PROCINITMAX 6
- static process prcinit[PROCINITMAX]; /* initial process free list */
-
-
- /* init_process - initialize the process module */
- init_process ()
- { process *p;
- int i;
-
- /* first make the initial process free list */
- for (p = prcinit, i = 0; i < PROCINITMAX; i++, p++) {
- p->next = fr_process;
- fr_process = p;
- }
-
- /* make the process associated with the driver */
- currentProcess = cr_process(o_drive);
- assign(currentProcess->next, currentProcess);
- assign(currentProcess->prev, currentProcess);
- currentProcess->p_state = ACTIVE;
- }
-
- /* cr_process - create a new process with the given interpreter */
- process *cr_process (anInterpreter)
- interpreter *anInterpreter;
- { process *new;
-
- if (fr_process) {
- new = (process *) fr_process;
- fr_process = fr_process->next;
- }
- else
- new = structalloc(process);
-
- new->p_ref_count = 0;
- new->p_size = PROCSIZE;
-
- sassign(new->interp, anInterpreter);
- new->p_state = SUSPENDED;
- sassign(new->next, (process *) o_nil);
- sassign(new->prev, (process *) o_nil);
-
- return(new);
- }
-
-
- /* free_process - return an unused process to free list */
- free_process (aProcess)
- process *aProcess;
- {
- obj_dec((object *) aProcess->interp);
- obj_dec((object *) aProcess->next);
- obj_dec((object *) aProcess->prev);
- aProcess->p_state = TERMINATED;
- aProcess->next = fr_process;
- fr_process = aProcess;
- }
-
- /* flush_processes - flush out any remaining process from queue */
- flush_processes ()
- {
- while (currentProcess != currentProcess->next)
- remove_process(currentProcess);
-
- /* prev link and next link should point to the same place now.
- In order to avoid having memory recovered while we are
- manipulating pointers, we increment reference count, then change
- pointers, then decrement reference counts */
-
- obj_inc((object *) currentProcess);
- safeassign(currentProcess->prev, (process *) o_nil);
- safeassign(currentProcess->next, (process *) o_nil);
- obj_dec((object *) currentProcess);
- }
-
-
- /* link_to_process - change the interpreter for the current process */
- link_to_process (anInterpreter)
- interpreter *anInterpreter;
- { object *temp;
-
- safeassign(runningProcess->interp, anInterpreter);
- }
-
-
- /* remove_process - remove a process from process queue */
- static remove_process (aProcess)
- process *aProcess;
- {
- if (aProcess == aProcess->next)
- cant_happen(15); /* removing last active process */
-
- /* currentProcess must always point to a process that is on the
- process queue, make sure this remains true */
-
- if (aProcess == currentProcess)
- currentProcess = currentProcess->prev;
-
- /* In order to avoid having memory recovered while we are changing
- pointers, we increment the reference counts on both processes,
- change pointers, then decrement reference counts */
-
- obj_inc((object *) currentProcess); obj_inc((object *) aProcess);
- safeassign(aProcess->next->prev, aProcess->prev);
- safeassign(aProcess->prev->next, aProcess->next);
- obj_dec((object *) currentProcess); obj_dec((object *) aProcess);
- }
-
-
- /* schedule_process - add a new process to the process queue */
- static schedule_process (aProcess)
- process *aProcess;
- {
- safeassign(aProcess->next, currentProcess);
- safeassign(aProcess->prev, currentProcess->prev);
- safeassign(aProcess->prev->next, aProcess);
- safeassign(currentProcess->prev, aProcess);
- }
-
- /* set_state - set the state on a process, which may involve inserting or
- removing it from the process queue */
- int set_state (aProcess, state)
- process *aProcess;
- int state;
- {
- switch (state) {
- case BLOCKED:
- case SUSPENDED:
- case TERMINATED: if (aProcess->p_state == ACTIVE)
- remove_process(aProcess);
- aProcess->p_state |= state;
- break;
-
- case READY:
- case UNBLOCKED: if ((aProcess->p_state ^ state) == ~ACTIVE)
- schedule_process(aProcess);
- aProcess->p_state &= state;
- break;
-
- case CUR_STATE: break;
- default: cant_happen(17);
- }
- return(aProcess->p_state);
- }
-
- # ifdef SETJUMP
- static jmp_buf intenv;
- # endif
-
- /* brkfun - what to do on a break key */
- brkfun()
- { static int warn = 1;
-
- # ifndef SETJUMP
- exit(1);
- # endif
- if (warn) {
- fprintf(stderr,"warning: recovery from interrupt may cause\n");
- fprintf(stderr,"reference counts to be incorrect, and\n");
- fprintf(stderr,"some memory to be inaccessible\n");
- warn = 0;
- }
- # ifdef SETJUMP
- longjmp(intenv, 1);
- # endif
- }
-
- /* start_execution - main execution loop */
- start_execution ()
- { interpreter *presentInterpreter;
-
- atomcnt = 0;
-
- # ifdef SIGS
- /* trap user interrupt signals and recover */
- signal(SIGINT, brkfun);
- # endif
-
- # ifdef SETJUMP
- if (setjmp(intenv)) {
- atomcnt = 0;
- link_to_process(o_drive);
- }
- # endif
-
- while (1) {
- /* unless it is an atomic action get the next process */
- if (! atomcnt)
- runningProcess = currentProcess = currentProcess->next;
-
- if (! is_driver(runningProcess->interp)) {
- sassign(presentInterpreter, runningProcess->interp);
- resume(presentInterpreter);
- obj_dec((object *) presentInterpreter);
- }
- else if (! test_driver((currentProcess == currentProcess->next) ||
- (atomcnt > 0)))
- break;
- }
- }
- End
- echo unbundling interp.c 1>&2
- cat >interp.c <<'End'
- /*
- Little Smalltalk
- bytecode interpreter
- timothy a. budd
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "drive.h"
- # include "cmds.h"
- # include "interp.h"
- # include "process.h"
- # include "number.h"
- # include "string.h"
- # include "symbol.h"
- # include "byte.h"
- # include "block.h"
- # include "primitive.h"
-
- int opcount[16], ohcount, spcount[16];
- extern object *o_smalltalk; /* value of pseudo variable smalltalk */
- extern object *fnd_class(); /* used to find classes from names */
-
- static mstruct *fr_interp = 0; /* interpreter memory free list */
- int ca_terp = 0; /* counter for interpreter allocations */
-
- /* cr_interpreter - create a new interpreter */
- interpreter *cr_interpreter(sender, receiver, literals, bitearray, context)
- interpreter *sender;
- object *literals, *bitearray, *receiver, *context;
- { interpreter *new;
- class *rclass;
- int isize;
-
- if (fr_interp) {
- new = (interpreter *) fr_interp;
- fr_interp = fr_interp->mlink;
- }
- else {
- new = structalloc(interpreter);
- ca_terp++;
- }
-
- new->t_ref_count = 0;
- new->t_size = INTERPSIZE;
-
- new->creator = (interpreter *) 0;
- if (sender)
- sassign(new->sender, sender);
- else
- sassign(new->sender, (interpreter *) o_nil);
- sassign(new->literals, literals);
- sassign(new->bytecodes, bitearray);
- sassign(new->receiver, receiver);
- rclass = (class *) fnd_class(receiver);
- if ((! rclass) || ! is_class(rclass))
- isize = 25;
- else {
- isize = rclass->stack_max;
- }
- sassign(new->context, context);
- sassign(new->stack, new_obj((class *) 0, isize, 1));
- new->stacktop = &(new->stack)->inst_var[0];
- new->currentbyte = byte_value(new->bytecodes);
- return(new);
- }
-
- /* free_terpreter - return an unused interpreter to free list */
- free_terpreter(anInterpreter)
- interpreter *anInterpreter;
- {
- if (! is_interpreter(anInterpreter))
- cant_happen(8);
-
- obj_dec((object *) anInterpreter->sender);
- obj_dec(anInterpreter->receiver);
- obj_dec(anInterpreter->bytecodes);
- obj_dec(anInterpreter->literals);
- obj_dec(anInterpreter->context);
- obj_dec(anInterpreter->stack);
-
- ((mstruct *) anInterpreter)->mlink = fr_interp;
- fr_interp = (mstruct *) anInterpreter;
- }
-
- /* copy_arguments - copy an array of arguments into the context */
- copy_arguments(anInterpreter, argLocation, argCount, argArray)
- interpreter *anInterpreter;
- int argLocation, argCount;
- object **argArray;
- { object *context = anInterpreter->context;
- int i;
-
- for (i = 0; i < argCount; argLocation++, i++) {
- assign(context->inst_var[ argLocation ], argArray[i]);
- }
- }
-
- # define push(x) {assign(*(anInterpreter->stacktop), x); \
- anInterpreter->stacktop++;}
-
- /* push_object - push a returned value on to an interpreter stack */
- push_object(anInterpreter, anObject)
- interpreter *anInterpreter;
- object *anObject;
- {
- push(anObject); /* what? no bounds checking?!? */
- }
-
- # define nextbyte(x) {x = uctoi(*anInterpreter->currentbyte);\
- anInterpreter->currentbyte++;}
- # define instvar(x) (anInterpreter->receiver)->inst_var[ x ]
- # define tempvar(x) (anInterpreter->context)->inst_var[ x ]
- # define lit(x) (anInterpreter->literals)->inst_var[ x ]
- # define popstack() (*(--anInterpreter->stacktop))
- # define decstack(x) (anInterpreter->stacktop -= x)
- # define skip(x) (anInterpreter->currentbyte += x )
-
- /* resume - resume executing bytecodes associated with an interpreter */
- resume(anInterpreter)
- register interpreter *anInterpreter;
- {
- int highBits;
- register int lowBits;
- object *tempobj, *receiver, *fnd_super();
- interpreter *sender;
- int i, j, numargs, arglocation;
- char *message;
-
- while(1) {
- nextbyte(highBits);
- lowBits = highBits % 16;
- highBits /= 16;
-
- switchtop:
- opcount[highBits]++;
- switch(highBits) {
- default: cant_happen(9);
- break;
-
- case 0: /* two bit form */
- highBits = lowBits;
- nextbyte(lowBits);
- goto switchtop;
-
- case 1: /* push instance variable */
- push(instvar(lowBits));
- break;
-
- case 2: /* push context value */
- push(tempvar(lowBits));
- break;
-
- case 3: /* literals */
- push(lit(lowBits));
- break;
-
- case 4: /* push class */
- tempobj = lit(lowBits);
- if (! is_symbol(tempobj)) cant_happen(9);
- tempobj = primitive(FINDCLASS, 1, &tempobj);
- push(tempobj);
- break;
-
- case 5: /* special literals */
- if (lowBits < 10)
- tempobj = new_int(lowBits);
- else if (lowBits == 10)
- tempobj = new_int(-1);
- else if (lowBits == 11)
- tempobj = o_true;
- else if (lowBits == 12)
- tempobj = o_false;
- else if (lowBits == 13)
- tempobj = o_nil;
- else if (lowBits == 14)
- tempobj = o_smalltalk;
- else if (lowBits == 15)
- tempobj = (object *) runningProcess;
- else if ((lowBits >= 30) && (lowBits < 60)) {
- /* get class */
- tempobj =
- new_sym(classpecial[lowBits-30]);
- tempobj = primitive(FINDCLASS, 1,
- &tempobj);
- }
- else tempobj = new_int(lowBits);
- push(tempobj);
- break;
-
- case 6: /* pop and store instance variable */
- assign(instvar(lowBits), popstack());
- break;
-
- case 7: /* pop and store in context */
- assign(tempvar(lowBits), popstack());
- break;
-
- case 8: /* send a message */
- numargs = lowBits;
- nextbyte(i);
- tempobj = lit(i);
- if (! is_symbol(tempobj)) cant_happen(9);
- message = symbol_value(tempobj);
- goto do_send;
-
- case 9: /* send a superclass message */
- numargs = lowBits;
- nextbyte(i);
- tempobj = lit(i);
- if (! is_symbol(tempobj)) cant_happen(9);
- message = symbol_value(tempobj);
- receiver =
- fnd_super(anInterpreter->receiver);
- goto do_send2;
-
- case 10: /* send a special unary message */
- numargs = 0;
- message = unspecial[lowBits];
- goto do_send;
-
- case 11: /* send a special binary message */
- numargs = 1;
- message = binspecial[lowBits];
- goto do_send;
-
- case 12: /* send a special arithmetic message */
- tempobj = *(anInterpreter->stacktop - 2);
- if (! is_integer(tempobj)) goto ohwell;
- i = int_value(tempobj);
- tempobj = *(anInterpreter->stacktop - 1);
- if (! is_integer(tempobj)) goto ohwell;
- j = int_value(tempobj);
- decstack(2);
- switch(lowBits) {
- case 0: i += j; break;
- case 1: i -= j; break;
- case 2: i *= j; break;
- case 3: if (i < 0) i = -i;
- i %= j; break;
- case 4: if (j < 0) i >>= (-j);
- else i <<= j; break;
- case 5: i &= j; break;
- case 6: i |= j; break;
- case 7: i = (i < j); break;
- case 8: i = (i <= j); break;
- case 9: i = (i == j); break;
- case 10: i = (i != j); break;
- case 11: i = (i >= j); break;
- case 12: i = (i > j); break;
- case 13: i %= j; break;
- case 14: i /= j; break;
- case 15: i = (i < j) ? i : j;
- break;
- case 16: i = (i < j) ? j : i;
- break;
- default: cant_happen(9);
- }
- if ((lowBits < 7) || (lowBits > 12))
- tempobj = new_int(i);
- else tempobj = (i ? o_true : o_false);
- push(tempobj);
- break;
-
- ohwell: /* oh well, send message */
- ohcount++;
- numargs = 1;
- message = arithspecial[lowBits];
- goto do_send;
-
- case 13: /* send a special ternary keyword messae */
- numargs = 2;
- message = keyspecial[lowBits];
- goto do_send;
-
- case 14: /* block creation */
- numargs = lowBits;
- if (numargs)
- nextbyte(arglocation);
- nextbyte(i); /* size of block */
- push(new_block(anInterpreter, numargs,
- arglocation));
- skip(i);
- break;
-
- case 15: /* special bytecodes */
- spcount[lowBits]++;
- switch(lowBits) {
- case 0: /* no - op */
- break;
- case 1: /* duplicate top of stack */
- push(*(anInterpreter->stacktop - 1));
- break;
- case 2: /* pop top of stack */
- anInterpreter->stacktop--;
- break;
- case 3: /* return top of stack */
- tempobj = popstack();
- goto do_return;
- case 4: /* block return */
- block_return(anInterpreter, popstack());
- return;
- case 5: /* self return */
- tempobj = tempvar(0);
- goto do_return;
- case 6: /* skip on true */
- nextbyte(i);
- tempobj = popstack();
- if (tempobj == o_true) {
- skip(i);
- push(o_nil);
- }
- break;
- case 7: /* skip on false */
- nextbyte(i);
- tempobj = popstack();
- if (tempobj == o_false) {
- skip(i);
- push(o_nil);
- }
- break;
- case 8: /* just skip */
- nextbyte(i);
- skip(i);
- break;
- case 9: /* skip backward */
- nextbyte(i);
- skip( - i );
- break;
- case 10: /* execute a primitive */
- nextbyte(numargs);
- nextbyte(i); /* primitive number */
- if (i == BLOCKEXECUTE)
- goto blk_execute;
- else if (i == DOPERFORM)
- goto do_perform;
- else {
- decstack(numargs);
- tempobj = primitive(i, numargs,
- anInterpreter->stacktop);
- push(tempobj);
- }
- break;
- case 11: /* skip true, push true */
- nextbyte(i);
- tempobj = popstack();
- if (tempobj == o_true) {
- skip(i);
- anInterpreter->stacktop++;
- }
- break;
- case 12: /* skip on false, push false */
- nextbyte(i);
- tempobj = popstack();
- if (tempobj == o_false) {
- skip(i);
- anInterpreter->stacktop++;
- }
- break;
- default:
- cant_happen(9);
- }
- break;
- }
- }
- /* sorry for the unstructured gotos.
- the sins of unstructuredness seemed less bothersome than
- the problems of not doing the same thing in all places
- -tab
- */
- do_perform: /* process perform:withArguments: */
- tempobj = popstack();
- message = symbol_value(tempobj);
- tempobj = popstack();
- numargs = tempobj->size - 1;
- for (i = 0; i <= numargs; i++)
- push(tempobj->inst_var[i]);
- /* fall through into do_send */
-
- /* do_send - call courier to send a message */
- do_send:
- receiver = *(anInterpreter->stacktop - (numargs + 1));
- do_send2:
- decstack(numargs + 1);
- send_mess(anInterpreter, receiver, message,
- anInterpreter->stacktop , numargs);
- return;
-
- /* do_return - return from a message */
- do_return:
- sender = anInterpreter->sender;
- if (is_interpreter(sender)) {
- if (! is_driver(sender))
- push_object(sender, tempobj);
- link_to_process(sender);
- }
- else {
- terminate_process(runningProcess);
- }
- return;
-
- /* blk_execute - perform the block execute primitive */
- blk_execute:
- tempobj = popstack();
- if (! is_integer(tempobj)) cant_happen(9);
- numargs = int_value(tempobj);
- sender = block_execute(anInterpreter->sender,
- (block *) tempvar(0), numargs, &tempvar(1));
- link_to_process(sender);
- return;
- }
- End
- echo unbundling block.c 1>&2
- cat >block.c <<'End'
- /*
- Little Smalltalk
-
- block creation and block return
- timothy a. budd, 10/84
-
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "drive.h"
- # include "interp.h"
- # include "block.h"
- # include "string.h"
- # include "primitive.h"
- # include "process.h"
-
- extern object *o_object; /* value of generic object */
-
- static mstruct *fr_block = 0; /* free list of unused blocks */
-
- int ca_block = 0; /* count block allocations */
-
- /* cpyInterpreter - make a new copy of an existing interpreter */
- static interpreter *cpyInterpreter(anInterpreter)
- interpreter *anInterpreter;
- { interpreter *new;
-
- new = cr_interpreter((interpreter *) 0,
- anInterpreter->receiver,
- anInterpreter->literals,
- anInterpreter->bytecodes,
- anInterpreter->context);
-
- if (anInterpreter->creator)
- new->creator = anInterpreter->creator;
- else
- new->creator = anInterpreter;
-
- new->currentbyte = anInterpreter->currentbyte;
- return(new);
- }
-
- /* new_block - create a new instance of class Block */
- object *new_block(anInterpreter, argcount, arglocation)
- interpreter *anInterpreter;
- int argcount, arglocation;
- { block *new;
-
- if (fr_block) {
- new = (block *) fr_block;
- fr_block = fr_block->mlink;
- }
- else {
- new = structalloc(block);
- ca_block++;
- }
-
- new->b_ref_count = 0;
- new->b_size = BLOCKSIZE;
-
- sassign(new->b_interpreter, cpyInterpreter(anInterpreter));
- new->b_numargs = argcount;
- new->b_arglocation = arglocation;
- return((object *) new);
- }
-
- /* free_block - return an unused block to the block free list */
- free_block(b)
- block *b;
- {
- if (! is_block(b))
- cant_happen(8);
-
- obj_dec((object *)(b->b_interpreter));
-
- ((mstruct *) b)->mlink = fr_block;
- fr_block = (mstruct *) b;
- }
-
- /* block_execute - queue a block interpreter for execution */
- interpreter *block_execute(sender, aBlock, numargs, args)
- interpreter *sender;
- block *aBlock;
- int numargs;
- object **args;
- { interpreter *newInt;
- object *tempobj;
-
- if (! is_block(aBlock)) cant_happen(11);
- if (numargs != aBlock->b_numargs) {
- sassign(tempobj,
- new_str("wrong number of arguments for block"));
- primitive(ERRPRINT, 1, &tempobj);
- obj_dec(tempobj);
- if (sender) {
- push_object(sender, o_nil);
- }
- return(sender); /* not sure about this ..... */
- }
-
- /* we copy the interpreter so as to not destroy the original and to
- avoid memory pointer cycles */
-
- newInt = cpyInterpreter(aBlock->b_interpreter);
- if (sender)
- assign(newInt->sender, sender);
- if (numargs)
- copy_arguments(newInt, aBlock->b_arglocation,
- numargs, args);
- return(newInt);
- }
-
- /* block_return - return an object from the context in which a block was
- created */
- block_return(blockInterpreter, anObject)
- interpreter *blockInterpreter;
- object *anObject;
- { interpreter *backchain, *parent;
- interpreter *creatorblock;
-
- creatorblock = blockInterpreter->creator;
- for (backchain = blockInterpreter->sender; backchain;
- backchain = backchain->sender) {
- if (! is_interpreter(backchain)) break;
- if (backchain == creatorblock) {
- /* found creating context, back up one more */
- parent = backchain->sender;
- if (parent) {
- if (! is_driver(parent))
- push_object(parent, anObject);
- link_to_process(parent);
- }
- else {
- terminate_process(runningProcess);
- }
- return;
- }
- }
-
- /* no block found, issue error message */
- primitive(BLKRETERROR, 1, (object **) &blockInterpreter);
- parent = blockInterpreter->sender;
- if (parent) {
- if (! is_driver(parent))
- push_object(parent, anObject);
- link_to_process(parent);
- }
- else {
- terminate_process(runningProcess);
- }
- }
- End
- echo unbundling courier.c 1>&2
- cat >courier.c <<'End'
- /*
- Little Smalltalk
- courier - message passing interface
-
- timothy a. budd 10/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # include "interp.h"
- # include "string.h"
- # include "symbol.h"
- # include "primitive.h"
- # define streq(x,y) (strcmp(x,y) == 0)
-
- /* send_mess - find the method needed to respond to a message, create the
- proper context and interpreter for executing the method */
- send_mess(sender, receiver, message, args, numargs)
- interpreter *sender;
- object *receiver, **args;
- char *message;
- int numargs;
- { object *robject, *method;
- register object *message_array;
- object *context, *fnd_super(), *fnd_class();
- class *objclass;
- interpreter *anInterpreter;
- int i, maxc;
-
- for (robject = receiver; robject; ) {
- if (is_bltin(robject))
- objclass = (class *) fnd_class(robject);
- else
- objclass = robject->class;
- if ((objclass == (class *) 0) || ! is_class(objclass)) break;
-
- message_array = objclass->message_names;
- for (i = 0; i < message_array->size; i++) {
- if (symbol_value(message_array->inst_var[i]) ==
- message) {
- method = (objclass->methods)->inst_var[ i ];
- goto do_cmd;
- }
- }
- if (is_bltin(robject))
- robject = fnd_super(robject);
- else
- robject = robject->super_obj;
- }
-
- /* if we reach this point then no method has been found matching message */
- sassign(robject, new_obj((class *) 0, 2, 0));
- sassign(robject->inst_var[0], receiver);
- sassign(robject->inst_var[1], new_sym(message));
- primitive(NORESPONDERROR, 2, &(robject->inst_var[0]));
- obj_dec(robject);
- /* generate a message passing trace */
- backtrace(sender);
- /* return nil by default */
- if (is_interpreter(sender))
- push_object(sender, o_nil);
- goto clean_up;
-
- /* do an interpreted method */
- /* make a context and fill it in, make an interpeter and link it into
- process queue */
- do_cmd:
- maxc = objclass->context_size;
- sassign(context, new_obj((class *)0, maxc, 0));
- for (i = 0; i <= numargs; i++)
- sassign(context->inst_var[i], args[i]);
- for ( ; i < maxc ; i++ )
- sassign(context->inst_var[i], o_nil);
- anInterpreter = cr_interpreter(sender, robject, method->inst_var[1],
- method->inst_var[0], context);
- link_to_process(anInterpreter);
- obj_dec(context);
- goto clean_up;
-
- /* clean up after yourself */
- clean_up:
- return;
- }
-
- /* responds_to - see if a class responds to a message */
- int responds_to(message, aClass)
- char *message;
- class *aClass;
- { object *message_names;
- int i;
-
- message_names = aClass->message_names;
- for (i = 0; i < message_names->size; i++)
- if (streq(symbol_value(message_names->inst_var[i]),
- message))
- return(1);
- return(0);
- }
-
- /* backtrace - generate a backwards message passing trace */
- static backtrace(current)
- interpreter *current;
- {
- while (is_interpreter(current->sender) &&
- ! is_driver(current->sender)) {
- fnd_message(current->receiver, current->bytecodes);
- current = current->sender;
- }
- }
-
- /* fnd_message - find the message associated with an interpreter */
- static fnd_message(receiver, bytecodes)
- object *receiver, *bytecodes;
- { int i;
- class *oclass;
- object *messar, *temp;
- char buffer[100];
-
- oclass = (class *) fnd_class(receiver);
-
- messar = oclass->methods;
- for (i = 0; i < messar->size; i++) {
- if ((messar->inst_var[i])->inst_var[0] == bytecodes) {
- sprintf(buffer,"%s: backtrace. message %s",
- symbol_value(oclass->class_name),
- symbol_value(
- (oclass->message_names)->inst_var[i]));
- sassign(temp, new_str(buffer));
- primitive(ERRPRINT, 1, &temp);
- obj_dec(temp);
- return;
- }
- }
- cant_happen(24);
- }
-
- /* prnt_messages - print all the messages a class responds to.
- needed because the messages names array for some of the classes is
- created before ArrayedCollection, and thus some do not respond to
- do: */
- prnt_messages(aClass)
- class *aClass;
- { object *message_names;
- int i;
-
- message_names = aClass->message_names;
- for (i = 0; i < message_names->size; i++)
- primitive(SYMPRINT, 1, &message_names->inst_var[i]);
- }
- End
- echo unbundling lex.c 1>&2
- cat >lex.c <<'End'
- /*
- Little Smalltalk lexical analyzer for driver
- timothy a. budd 12/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include <ctype.h>
- # include <math.h>
- # define DRIVECODE
- # include "drive.h"
-
- # define MAXTOKEN 100
- char toktext[MAXTOKEN];
- tok_type t;
- enum lextokens token;
-
- extern char *lexptr;
- extern double atof();
-
- static char ocbuf = 0;
- static int pbbuf[20];
-
- # define input() (ocbuf ? pbbuf[--ocbuf] : *lexptr++ )
- # define putbak(c) (pbbuf[ocbuf++] = c)
-
- static char *psuvars[] = {"nil", "true", "false", "smalltalk", 0};
- static enum pseuvars psuval[] = {nilvar, truevar, falsevar, smallvar};
- static char symbols[] = "\n-()[]!|.;>" ;
- static enum lextokens symval[] = {NL, MINUS, LP, RP, LB, RB, BAR, BAR,
- PERIOD, SEMI, PE};
-
- static enum lextokens lexsave(type)
- enum lextokens type;
- { char *w_search();
-
- if (! (t.c = w_search(toktext, 1)))
- lexerr("cannot create symbol %s", toktext);
- /* assign token, and return value */
- return(token = type);
- }
-
- enum lextokens nextlex() {
- register char c;
- register char *p;
- char *q;
- int i, n, base;
- double d, denom;
-
- do { /* read whitespace (including comments) */
- c = input();
- if (c == '\"') {
- while ((c = input()) && c != '\"') ;
- if (c == '\"') c = input();
- else lexerr("unterminated comment", "");
- }
- } while (c == ' ' || c == '\t') ;
-
- if (!c) return(token = nothing);
-
- p = toktext;
- *p = c;
- toktext[1] = '\0';
-
- /* identifiers and keywords */
- if (( c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) {
- for (*p++ = c; (c = input()) && isalnum(c) ; *p++ = c) ;
- *p = '\0';
- lexsave(0);
- if (c == ':') {
- return(token = KEYWORD);
- }
- else {
- putbak(c);
- if (islower(toktext[0])) {
- for (i = 0; psuvars[i]; i++)
- if (strcmp(toktext, psuvars[i]) == 0) {
- t.p = psuval[i];
- return(token = PSEUDO);
- }
- return(token = LOWERCASEVAR);
- }
- else {
- return(token = UPPERCASEVAR);
- }
- }
- }
-
- # define scandigits(x) for(*p++ = c; (c = input()) && isdigit(c) ; *p++ = c) x
-
- if (c >= '0' && c <= '9') { /* numbers */
- i = c - '0';
- scandigits( i = 10 * i + (c - '0') );
- if (c == '.' || c == 'e') {
- if (c == '.')
- scandigits();
- if (c == 'e') {
- *p++ = c;
- c = input();
- if (c == '+' || c == '-') {
- *p++ = c; c = input(); }
- scandigits();
- }
- putbak(c);
- *p = '\0';
- t.f = atof(toktext);
- return(token = LITFNUM);
- }
- else if ((c == 'r') && ((i >= 2) && (i <= 36))) {
- base = i;
- i = 0;
- for (*p++ = c; c = input(); *p++ = c) {
- if (isdigit(c)) n = c - '0';
- else if (isupper(c)) n = (c - 'A') + 10;
- else break;
- if (n >= base) break;
- i = base * i + n;
- }
- if (c == '.' || c == 'e') {
- d = (double) i;
- if (c == '.') {
- denom = 1.0 / (double) base;
- for (*p++ = c; c = input(); *p++ = c) {
- if (isdigit(c))
- n = c - '0';
- else if (isupper(c))
- n = (c - 'A') + 10;
- else break;
- if (n >= base) break;
- d += n * denom;
- denom /= base;
- }
- }
- if (c == 'e') {
- *p++ = c;
- c = input();
- if (c == '+' || c == '-') {
- n = c;
- *p++ = c;
- c = input();
- }
- else n = 0;
- i = c - '0';
- scandigits(i = 10 * i + (c - '0'));
- if (n == '-') i = - i;
- d *= pow((double) base, (double) i);
- }
- putbak(c);
- *p = '\0';
- t.f = d;
- return(token = LITFNUM);
- }
- }
- putbak(c);
- *p = '\0';
- t.i = i;
- return(token = LITNUM);
- }
-
- if (c == '#') { /* symbol */
- i = 1;
- while (i)
- switch(c = input()) {
- case '\0': case ' ': case '\t': case '\n':
- case '(': case '[': case ')':
- putbak(c);
- i = 0;
- break;
- default:
- *p++ = c;
- }
- if (p == toktext)
- return(token = PS);
- else {
- *p = '\0';
- if ((p - toktext) >= MAXTOKEN) cant_happen(18);
- return(lexsave(LITSYM));
- }
- }
-
- if (c == '\'') { /* quoted string */
- do {
- for ( ; (c = input()) && c != '\'' ; *p++ = c) ;
- c = input();
- if (c == '\'') *p++ = '\'';
- } while (c == '\'');
- putbak(c);
- *p = '\0';
- if ((p - toktext) >= MAXTOKEN) cant_happen(18);
- t.c = toktext;
- return(token = LITSTR);
- }
-
- if (c == ':') { /* colon or argument name */
- c = input();
- if (c == '=')
- return(token = ASSIGN);
- else if (isalnum(c)) {
- for (*p++ = c; isalnum(c = input()); *p++ = c );
- putbak(c);
- *p = '\0';
- return(lexsave(COLONVAR));
- }
- putbak(c);
- return(lexsave(BINARY));
- }
-
- if (c == '<') { /* assign, less than or primitive */
- *p++ = c; *p = '\0';
- c = input();
- if (c == '-')
- return(token = ASSIGN);
- for (p = q = "primitive"; *p && *p == c; p++)
- c = input();
- putbak(c);
- if (*p) {
- for (p--; p >= q; p--) putbak(*p);
- return(lexsave(BINARY));
- }
- else
- return(token = PRIMITIVE);
- }
-
- if (c == '.') { /* number or period */
- c = input();
- if (c >= '0' && c <= '9') {
- putbak(c); /* reparse with digit */
- putbak('.'); /* inserted on front */
- putbak('0'); /* so it looks like */
- return(nextlex()); /* a number */
- }
- putbak(c);
- return(token = PERIOD);
- }
-
- if (c == '\\') { /* binary or hidden newline */
- c = input();
- if (c == '\n')
- return(nextlex());
- putbak(c);
- return(lexsave(BINARY));
- }
-
- if (c == '$') { /* literal character or binary */
- c = input();
- if (c) {
- t.i = c;
- return(token = LITCHAR);
- }
- return(lexsave(BINARY));
- }
-
- for (i = 0; symbols[i]; i++)
- if (c == symbols[i])
- return(lexsave(symval[i]));
-
- return(lexsave(BINARY));
- }
- End
- echo unbundling drive.c 1>&2
- cat >drive.c <<'End'
- /*
- Little Smalltalk
- command parser
-
- timothy a. budd, 12/84
-
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "object.h"
- # define DRIVECODE
- # include "drive.h"
- # include "cmds.h"
- # include "number.h"
- # include "symbol.h"
- # include "string.h"
- # include "byte.h"
- # include "interp.h"
- # include "primitive.h"
-
- extern enum lextokens token, nextlex();
- extern int prntcmd;
- extern int inisstd;
- extern int started;
- extern char toktext[];
- extern char *lexptr;
- extern int line_grabber();
- extern tok_type t;
-
- /* test_driver - see if the driver should be invoked */
- int test_driver(block)
- int block; /* indicates wheter to use block or non-blocking input */
- {
- switch(line_grabber( block )) {
- default: cant_happen(17);
- case -1:
- /* return end of file indication */
- return(0);
- case 0:
- /* enqueue driver process again */
- return(1);
- case 1:
- if (*lexptr == ')') {
- dolexcommand(lexptr);
- return(1);
- }
- parse();
- return(1);
- }
- }
-
- /* ---- code generation routines -------------- */
- # define CODEMAX 500
- static uchar code[CODEMAX];
- static int codetop = 0;
-
- static gencode(value)
- register int value;
- {
- if (value >= 256)
- lexerr("code word too big: %d", value);
- if (codetop > CODEMAX)
- lexerr("too many code words: %d", codetop);
- /*if (started)
- fprintf(stderr,"code %d (%d %d)\n", value, value/16, value%16);*/
- code[codetop++] = itouc(value);
- }
-
- static genhighlow(high, low)
- register int high;
- register int low;
- {
- if (high < 0 || high > 16)
- lexerr("genhighlow error: %d", high);
- if (low < 0)
- lexerr("genhighlow low error: %d", low);
- if (low < 16) gencode(high * 16 + low);
- else {
- gencode(TWOBIT * 16 + high);
- gencode(low);
- }
- }
- /*-------------------------------------------------------*/
-
- static int errflag;
-
- /* parse - main parser */
- int parse()
- { register int i;
-
- errflag = 0;
- reset();
-
- if (nextlex() == nothing) return(1);
- if (token == NL) return(1);
-
- i = aprimary();
- if (i >= 0) {
- asign(i);
- if ((prntcmd > 1) && inisstd)
- genhighlow(UNSEND, PRNTCMD);
- }
- else {
- cexpression();
- if (prntcmd && inisstd)
- genhighlow(UNSEND, PRNTCMD);
- }
- genhighlow(POPINSTANCE, 0); /* assign to ``last'' */
- if (errflag)
- return(1);
- if (token == nothing || token == NL) {
- bld_interpreter();
- return(0);
- }
- expect("end of expression");
- return(1);
- }
-
- /* asign - code for an assignment statement - leaves result on stack */
- static asign(pos)
- int pos;
- { int i;
-
- i = aprimary();
- if (i >= 0) {
- asign(i);
- }
- else {
- cexpression();
- }
- genhighlow(SPECIAL, DUPSTACK);
- genhighlow(POPINSTANCE, pos);
- }
-
- /* expression - read an expression, leaving result on stack */
- static expression()
- { int i;
-
- i = aprimary();
- if (i >= 0) {
- asign(i);
- }
- else {
- cexpression();
- }
- }
-
- /* cexpression - code for a (possibly cascaded) expression */
- static cexpression()
- {
- kcontinuation();
- while (token == SEMI) {
- genhighlow(SPECIAL, DUPSTACK);
- nextlex();
- kcontinuation();
- genhighlow(SPECIAL, POPSTACK);
- }
- }
-
- /* kcontinuation - keyword continuation */
- static kcontinuation()
- { char kbuf[150];
- int kcount;
-
- bcontinuation();
- if (token == KEYWORD) {
- kbuf[0] = '\0';
- kcount = 0;
- while (token == KEYWORD) {
- strcat(kbuf, t.c);
- strcat(kbuf, ":");
- kcount++;
- nextlex();
- primary(1);
- bcontinuation();
- }
- gensend(kbuf, kcount);
- }
- }
-
- /* isbinary - see if the current token(s) is a binary */
- static int isbinary(bbuf)
- char *bbuf;
- {
- if (token == BINARY || token == MINUS ||
- token == BAR || token == PE) {
- strcpy(bbuf, t.c);
- nextlex();
- if (token == BINARY || token == MINUS ||
- token == BAR || token == PE) {
- strcat(bbuf, t.c);
- nextlex();
- }
- return(1);
- }
- return(0);
- }
-
- /* bcontinuation - binary continuation */
- static bcontinuation()
- { char bbuf[3];
-
- ucontinuation();
- while (isbinary(bbuf)) {
- primary(1);
- ucontinuation();
- gensend(bbuf, 1);
- }
- }
-
- /* ucontinuation - unary continuation */
- static ucontinuation()
- {
- while (token == LOWERCASEVAR) {
- gensend(t.c, 0);
- nextlex();
- }
- }
-
- /* aprimary - primary or beginning of assignment */
- static int aprimary()
- { char *c;
-
- if (token == LOWERCASEVAR) {
- c = t.c;
- if (nextlex() == ASSIGN) {
- nextlex();
- return(findvar(c, 1));
- }
- else {
- genvar(c);
- return( -1 );
- }
- }
- primary(1);
- return( - 1 );
- }
-
- /* primary - find a primary expression */
- static int primary(must)
- int must; /* must we find something ? */
- { int i, count;
-
- switch(token) {
- case UPPERCASEVAR:
- genhighlow(PUSHCLASS, aliteral(1));
- break;
-
- case LOWERCASEVAR:
- genvar(t.c);
- nextlex();
- break;
-
- case LITNUM:
- if (t.i >= 0 && t.i < 10) {
- genhighlow(PUSHSPECIAL, t.i);
- nextlex();
- }
- else {
- genhighlow(PUSHLIT, aliteral(1));
- }
- break;
-
- case MINUS:
- case LITFNUM:
- case LITCHAR:
- case LITSTR:
- case LITSYM:
- case PS:
- genhighlow(PUSHLIT, aliteral(1));
- break;
-
- case PSEUDO:
- switch(t.p) {
- case nilvar: i = 13; break;
- case truevar: i = 11; break;
- case falsevar: i = 12; break;
- case smallvar: i = 14; break;
- default: lexerr("unknown pseudo var %d", t.p);
- }
- genhighlow(PUSHSPECIAL, i);
- nextlex();
- break;
-
- case PRIMITIVE:
- if (nextlex() != LITNUM) expect("primitive number");
- i = t.i;
- nextlex();
- count = 0;
- while (primary(0)) count++;
- if (token != PE) expect("primitive end");
- nextlex();
- genhighlow(SPECIAL, PRIMCMD);
- gencode(count);
- gencode(i);
- break;
-
- case LP:
- nextlex();
- expression();
- if (token != RP) expect("right parenthesis");
- nextlex();
- break;
-
- case LB:
- nextlex();
- block();
- break;
-
- default:
- if (must) expect("primary expression");
- return(0);
- }
- return(1);
- }
-
- static int maxtemps = 1;
- static int temptop = 0;
- static char *tempnames[20];
-
- /* block - parse a block definition */
- static block()
- { int count, i, position;
-
- count = 0;
- if (token == COLONVAR) {
- while (token == COLONVAR) {
- tempnames[temptop++] = t.c;
- if (temptop > maxtemps) maxtemps = temptop;
- count++;
- nextlex();
- }
- if (token != BAR)
- expect("bar following arguments in block");
- nextlex();
- }
- genhighlow(BLOCKCREATE, count);
- if (count) /* where arguments go in context */
- gencode(1 + (temptop - count));
- position = codetop;
- gencode(0);
-
- if (token == RB) {
- genhighlow(PUSHSPECIAL, 13);
- }
- else
- while (1) {
- i = aprimary();
- if (i >= 0) {
- expression();
- if (token != PERIOD)
- genhighlow(SPECIAL, DUPSTACK);
- genhighlow(POPINSTANCE, i);
- }
- else {
- cexpression();
- if (token == PERIOD)
- genhighlow(SPECIAL, POPSTACK);
- }
- if (token != PERIOD)
- break;
- nextlex();
- }
- genhighlow(SPECIAL, RETURN);
- if (token != RB) expect("end of block");
- temptop -= count;
- nextlex();
- i = (codetop - position) - 1;
- if (i > 255)
- lexerr("block too big %d", i);
- code[position] = itouc(i);
- }
-
- # define LITMAX 100
- static object *lit_array[LITMAX];
- static int littop = 0;
-
- static int addliteral(lit)
- object *lit;
- {
- if (littop >= LITMAX)
- cant_happen(18);
- sassign(lit_array[littop++], lit);
- return(littop - 1);
- }
-
- /* aliteral - find a literal that is part of a literal array */
- static int aliteral(must)
- int must; /* must we find something ? */
- { char *c;
- object *new;
- int count;
- int bytetop;
- uchar bytes[200];
-
- switch(token) {
- case MINUS:
- c = t.c;
- nextlex();
- if (token == LITNUM) {
- new = new_int( - t.i );
- nextlex();
- }
- else if (token == LITFNUM) {
- new = new_float( - t.f );
- nextlex();
- }
- else {
- new = new_sym(c);
- }
- break;
-
- case LITNUM:
- new = new_int(t.i);
- nextlex();
- break;
-
- case LITFNUM:
- new = new_float(t.f);
- nextlex();
- break;
-
- case LITCHAR:
- new = new_char(t.i);
- nextlex();
- break;
-
- case LITSTR:
- new = new_str(t.c);
- nextlex();
- break;
-
- case LITSYM:
- new = new_sym(t.c);
- nextlex();
- break;
-
- case PSEUDO:
- switch(t.p) {
- case nilvar: new = o_nil; break;
- case truevar: new = o_true; break;
- case falsevar: new = o_false; break;
- case smallvar: new = o_smalltalk; break;
- default: lexerr("unknown peudo %d", t.p);
- }
- nextlex();
- break;
-
- case PS:
- nextlex();
- if (token == LP) goto rdarray;
- else if (token == LB) {
- bytetop = 0;
- while (nextlex() == LITNUM)
- bytes[bytetop++] = itouc(t.i);
- if (token != RB)
- expect("right bracket");
- nextlex();
- new = new_bytearray(bytes, bytetop);
- }
- else expect("array or bytearray");
- break;
-
- case LP: rdarray:
- count = 0;
- nextlex();
- while (aliteral(0) >= 0) {
- count++;
- }
- if (token != RP) expect("right parenthesis");
- nextlex();
- new = new_array(count, 0);
- while (count)
- new->inst_var[--count] = lit_array[--littop];
- break;
-
- case UPPERCASEVAR:
- case LOWERCASEVAR:
- case KEYWORD:
- case COLONVAR:
- case BINARY:
- case PE:
- case BAR:
- case SEMI:
- new = new_sym(t.c);
- nextlex();
- break;
-
- default:
- if (must)
- expect("literal");
- else return( - 1 );
- }
- return(addliteral(new));
- }
-
- /* gensend - generate a message send */
- static gensend(message, numargs)
- char *message;
- int numargs;
- { int i;
- char **p, c;
- tok_type e;
-
- c = *message;
- if (numargs == 0) {
- for (p = unspecial, i = 0; *p; i++, p++)
- if ((**p == c) && (strcmp(*p, message) == 0)) {
- genhighlow(UNSEND, i);
- return;
- }
- }
- else if (numargs == 1) {
- for (p = binspecial, i = 0; *p; i++, p++)
- if ((**p == c) && (strcmp(*p, message) == 0)) {
- genhighlow(BINSEND, i);
- return;
- }
- for (p = arithspecial, i = 0; *p; i++, p++)
- if ((**p == c) && (strcmp(*p, message) == 0)) {
- genhighlow(ARITHSEND, i);
- return;
- }
- }
- else if (numargs == 2) {
- for (p = keyspecial, i = 0; *p; i++, p++)
- if ((**p == c) && (strcmp(*p, message) == 0)) {
- genhighlow(KEYSEND, i);
- return;
- }
- }
- genhighlow(SEND, numargs);
- gencode(addliteral(new_sym(message)));
- }
-
- static object *var_names;
- static object *var_values;
-
- extern object *o_nil, *o_true;
-
- static int findvar(str, make)
- char *str;
- int make;
- { int i;
- object *comp_obj;
-
- sassign(comp_obj, new_obj((class *) 0, 2, 0));
- sassign(comp_obj->inst_var[0], o_nil);
- sassign(comp_obj->inst_var[1], new_sym(str));
- for (i = 0; i < var_names->size; i++) {
- assign(comp_obj->inst_var[0], var_names->inst_var[i]);
- if (o_true == primitive(SYMEQTEST, 2, &(comp_obj->inst_var[0]))) {
- obj_dec(comp_obj);
- return(i);
- }
- }
- /* not found, perhaps it's new */
- if (make) {
- assign(comp_obj->inst_var[0], var_names);
- assign(var_names, primitive(GROW, 2, &(comp_obj->inst_var[0])));
- assign(comp_obj->inst_var[0], var_values);
- assign(comp_obj->inst_var[1], o_nil);
- assign(var_values, primitive(GROW, 2, &(comp_obj->inst_var[0])));
- }
- else {
- lexerr("unknown variable %s", str);
- i = 0;
- }
- obj_dec(comp_obj);
- return(i);
- }
-
- genvar(name)
- char *name;
- { int i;
-
- for (i = 0; i < temptop; i++)
- if (strcmp(name, tempnames[i]) == 0) {
- genhighlow(PUSHTEMP, i+1);
- return;
- }
- genhighlow(PUSHINSTANCE, findvar(name, 0));
- }
-
- /* lexerr - error printing with limited reformatting */
- lexerr(s, v)
- char *s, *v;
- {
- char e1[500], e2[500];
- object *new;
-
- errflag = 1;
- sprintf(e1, s, v); /* format error message */
- sprintf(e2, "error: %s\n", e1);
- sassign(new, new_str(e2));
- primitive(ERRPRINT, 1, &new);
- obj_dec(new);
- }
-
- expect(str)
- char *str;
- { char ebuf[150];
-
- /*fprintf(stderr,"expected %s\n", str);
- fprintf(stderr,"current token type %d\n", token);
- fprintf(stderr,"remainder of line %s\n", lexptr);
- fprintf(stderr,"current text %s\n", toktext);*/
- sprintf(ebuf,"expected %s found %s", str, toktext);
- lexerr(ebuf,"");
- }
-
- extern object *o_drive; /* ``driver'' interpreter */
-
- bld_interpreter()
- { interpreter *interp;
- object *literals, *bytecodes, *context;
- int i;
-
- if (codetop == 0) {
- return;
- }
- genhighlow(SPECIAL, SELFRETURN);
- gencode(0); /* mark end of bytecodes */
- sassign(literals, new_array(littop, 0));
- for (i = 0; i < littop; i++)
- literals->inst_var[ i ] = lit_array[i];
- sassign(bytecodes, new_bytearray(code, codetop));
- sassign(context, new_obj((class *) 0, 1 + maxtemps, 1));
- interp = cr_interpreter((interpreter *) o_drive, var_values,
- literals, bytecodes, context);
- link_to_process(interp);
- obj_dec(context);
- obj_dec(bytecodes);
- obj_dec(literals);
- }
-
- reset(){
- codetop = littop = temptop = 0;
- maxtemps = 1;
- }
-
- /* drv_init initializes the driver, should be called only once */
- drv_init() {
- sassign(var_names, new_obj((class *) 0, 0, 0));
- sassign(var_values, new_obj((class *) 0, 0, 0));
- reset();
- findvar("last", 1); /* create variable "last" */
- }
-
- drv_free() {
- int i;
-
- for (i = 0; i < var_values->size; i++)
- assign(var_values->inst_var[ i ], o_nil);
- obj_dec(var_names);
- obj_dec(var_values);
- }
- End
- echo unbundling lexcmd.c 1>&2
- cat >lexcmd.c <<'End'
- /*
- Little Smalltalk
- misc lexer related routines
- timothy a. budd 12/84
- */
- /*
- The source code for the Little Smalltalk System may be freely
- copied provided that the source of all files is acknowledged
- and that this condition is copied with each file.
-
- The Little Smalltalk System is distributed without responsibility
- for the performance of the program and without any guarantee of
- maintenance.
-
- All questions concerning Little Smalltalk should be addressed to:
-
- Professor Tim Budd
- Department of Computer Science
- Oregon State University
- Corvallis, Oregon
- 97331
- USA
- */
- # include <stdio.h>
- # include "env.h"
- # include <ctype.h>
-
- extern char toktext[];
-
- /* dolexcommand - read a ) type directive, and process it */
- dolexcommand(p)
- char *p;
- { char *q, buffer[100];
-
- /* replace trailing newline with end of string */
- for (q = p; *q && *q != '\n'; q++);
- if (*q == '\n') *q = '\0';
-
- switch( *++p) {
- case '!':
- # ifndef NOSYSTEM
- system(++p);
- # endif
- break;
-
- case 'e': for (++p; isspace(*p); p++);
- if (! lexedit(p)) lexinclude(p);
- break;
-
- case 'g': for (++p; isspace(*p); p++);
- sprintf(buffer,"%s/%s", LIBLOC, p);
- lexread(buffer);
- break;
-
- case 'i': for (++p; isspace(*p); p++);
- lexinclude(p);
- break;
-
- case 'r': for (++p; isspace(*p); p++);
- lexread(p);
- break;
-
- case 's': for(++p; isspace(*p); p++);
- dosave(p);
- break;
-
- case 'l': for(++p; isspace(*p); p++);
- doload(p);
- break;
-
- default: lexerr("unknown command %s", toktext);
- }
- }
-
- /* doload/dosave routines written by nick buchholz */
- /*
- doload and dosave routines make the following assumptions
- 1. version is the first global variable declared in main.
- 2. main is the first procedure seen by the loader
- 3. the loader allocates memory in the order it sees the procedures
- 4. memory is laid out as on the vax 780 under 4.2
-
- on other machines any or all of these might be false and the
- doload/dosave routines will not work
- */
- extern int version;
-
- dosave(p) char *p;{
- int fd;
- char *start, *end, *sbrk();
- unsigned int length, len;
- int dlen;
-
- # ifdef OPEN3ARG
- if ((fd = open(p, O_WRONLY|O_CREAT|O_TRUNC, 0666)) == -1)
- # endif
- # ifndef OPEN3ARG
- if ((fd = creat(p, 0666)) == -1)
- # endif
- fprintf(stderr,"can't open: %s\n",p);
-
- start = (char *) &version;
- end = sbrk(0);
- length = end - start;
-
- write(fd, &version, sizeof(int));
- write(fd, &start, sizeof(char *));
- write(fd, &length, sizeof(unsigned int));
-
- for (len = 0; len < length; len += dlen) {
- dlen = ((length - len) > 512) ? 512 : (length - len);
- if (dlen != write(fd, start + len, dlen)) {
- cant_happen(23);
- }
- }
-
- fprintf(stderr,"%u bytes written\n",len);
-
- close(fd);
- }
-
- # ifdef ENVSAVE
- extern char **environ;
- # endif
-
- doload(p) char *p;{
- int fd;
- char *start, *end, *brk();
- unsigned int length, len;
- int dlen;
- int test;
- # ifdef ENVSAVE
- char **evsave;
- # endif
-
- # ifdef OPEN3ARG
- if ((fd = open(p, O_RDONLY, 0)) == -1)
- # endif
- # ifndef OPEN3ARG
- if ((fd = open(p, 0 )) == -1)
- # endif
- fprintf(stderr,"no such context as: %s\n", p);
-
- else {
- read(fd, &test, sizeof(int));
- read(fd, &start, sizeof(char *));
- read(fd, &length, sizeof(unsigned int));
-
- if ((test != version) || (start != (char *) &version))
- fprintf(stderr,"%s: not a valid context file for version %d\n",
- p, version);
- else {
- start = (char *) &version;
- end = brk(start + length + 1);
- # ifdef ENVSAVE
- evsave = environ;
- # endif
-
- for (len = 0; len < length; len += dlen) {
- dlen = ((length - len) > 512) ? 512 : (length - len);
- if (dlen != read(fd, start + len, dlen)) {
- cant_happen(23);
- }
- }
- # ifdef ENVSAVE
- environ = evsave;
- # endif
- fprintf(stderr,"%u bytes read\n",len);
- }
- close(fd);
- }
- }
-
- /* lexread - read commands from a file */
- lexread(name)
- char *name;
- { FILE *fd;
-
- fd = fopen(name, "r");
- if (fd == NULL) {
- fprintf(stderr,"can't open %s\n", name);
- }
- else {
- set_file(fd);
- }
- }
-
- /* lexinclude - parse a class and include the class description */
- lexinclude(name)
- char *name;
- { char template[60], cmdbuf[120];
- int i;
-
- # ifndef NOSYSTEM
- gettemp(template);
- sprintf(cmdbuf,"%s %s >%s", PARSER, name, template);
- i = system(cmdbuf);
- if (i == 0)
- lexread(template);
- # endif
- # ifdef NOSYSTEM
- fprintf(stderr,")i does not work on this system\n");
- # endif
- }
-
- /* lexedit - edit a class description */
- int lexedit(name)
- char *name;
- { char *e, buffer[100], *getenv();
-
- # ifndef NOSYSTEM
- e = getenv("EDITOR");
- if (!e) e = "ed";
- sprintf(buffer,"%s %s", e, name);
- return(system(buffer));
- # endif
- # ifdef NOSYSTEM
- fprintf(stderr,")e does not work on this system\n");
- return(1);
- # endif
- }
- End